]>
Commit | Line | Data |
---|---|---|
ec1fac73 | 1 | #!@PERL@ |
cbac7592 AJ |
2 | |
3 | use strict; | |
4 | use warnings; | |
5 | use Getopt::Long qw(:config auto_version auto_help); | |
6 | use Pod::Usage; | |
7 | ||
ec1fac73 FC |
8 | =pod |
9 | ||
10 | =head1 NAME | |
11 | ||
cbac7592 | 12 | delayer - Squid external ACL helper adding artificial delay to requests |
ec1fac73 FC |
13 | |
14 | =head1 SYNOPSIS | |
15 | ||
cbac7592 AJ |
16 | delayer [--help] [--debug] [--log file] [--wait msec] |
17 | ||
18 | =head1 DESCRIPTION | |
19 | ||
20 | Squid external acl helper; causes squid to delay responding to HTTP requests. | |
21 | ||
22 | By carefully crafting the ACLs of a Squid setup it is possible to | |
23 | selectively delay requests received by a proxy. After the configured amount | |
24 | of time, it will always return "true". | |
ec1fac73 FC |
25 | |
26 | =head1 OPTIONS | |
27 | ||
cbac7592 | 28 | =over 12 |
ec1fac73 FC |
29 | |
30 | =item B<--help> or B<-h> | |
31 | ||
32 | Print help message to stdout | |
33 | ||
34 | =item B<--debug> or B<-d> | |
35 | ||
36 | Emit debugging output to STDERR and ultimately cache.log | |
37 | ||
38 | =item B<--log /path/to/file> or B<-l /path/to/file> | |
39 | ||
40 | Emit debugging output to specified file instead of STDERR. Also turns on debugging | |
41 | ||
42 | =item B<--wait msec> or B<-w msec> | |
43 | ||
44 | Delay each request by the specified amount of msec. | |
45 | Unless this option is specified, by default each submitted request | |
46 | will be delayed by half a second (500 msec). | |
47 | ||
48 | =back | |
49 | ||
ec1fac73 FC |
50 | =head1 CONFIGURATION |
51 | ||
52 | To engage it, this snippet of configuration template can be used in squid.conf: | |
53 | ||
54 | external_acl_type delayer concurrency=100000 children-max=2 children-startup=1 children-idle=1 cache=10 %URI /path/to/delayer -w 200 | |
55 | acl delay external delayer | |
56 | http_access allow acl1 acl2 acl3 delay !all | |
57 | ||
58 | It is important that the acl referencing the delayer be the penultimate clause in the | |
59 | http_access line. It will cause delay to all requests that match all the | |
60 | preceding acls in the line. The !all clause at the end of the line will make it | |
61 | so that no traffic is authorized by this ACL, only the delay to evaluate | |
62 | the delay clause will be inserted before evaluating following http_access lines. | |
63 | It is also important to place the http_access line carefully in the sequence | |
64 | of all http_access_lines; it should be near the beginning, but be careful | |
65 | not to insert unwanted slow acls (especially proxy_auth). | |
66 | ||
67 | It is possible to customize how delay is calculated for each request by | |
68 | modifying the "calc_delay" PERL function in the script, documentation on this | |
69 | is embedded in the source code comments. | |
70 | ||
71 | =head1 AUTHOR | |
72 | ||
73 | This software is written by Francesco Chemolli <kinkie@squid-cache.org> | |
74 | ||
75 | =head1 COPYRIGHT | |
76 | ||
ca02e0ec AJ |
77 | * Copyright (C) 1996-2014 The Squid Software Foundation and contributors |
78 | * | |
79 | * Squid software is distributed under GPLv2+ license and includes | |
80 | * contributions from numerous individuals and organizations. | |
81 | * Please see the COPYING and CONTRIBUTORS files for details. | |
82 | ||
cbac7592 | 83 | (C) 2014 Francesco Chemolli <kinkie@squid-cache.org> |
ec1fac73 | 84 | |
cbac7592 AJ |
85 | This program is free software. You may redistribute copies of it under the |
86 | terms of the GNU General Public License version 2, or (at your opinion) any | |
87 | later version. | |
ec1fac73 FC |
88 | |
89 | =head1 QUESTIONS | |
90 | ||
cbac7592 | 91 | Questions on the usage of this program can be sent to the I<Squid Users mailing list <squid-users@squid-cache.org>> |
ec1fac73 FC |
92 | |
93 | =head1 REPORTING BUGS | |
94 | ||
95 | Bug reports need to be made in English. | |
cbac7592 AJ |
96 | See http://wiki.squid-cache.org/SquidFaq/BugReporting for details of what you need to include with your bug report. |
97 | ||
ec1fac73 FC |
98 | Report bugs or bug fixes using http://bugs.squid-cache.org/ |
99 | ||
cbac7592 AJ |
100 | Report serious security bugs to I<Squid Bugs <squid-bugs@squid-cache.org>> |
101 | ||
102 | Report ideas for new improvements to the I<Squid Developers mailing list <squid-dev@squid-cache.org>> | |
103 | ||
ec1fac73 FC |
104 | =head1 SEE ALSO |
105 | ||
cbac7592 AJ |
106 | squid (8), GPL (7), |
107 | ||
108 | The Squid FAQ wiki http://wiki.squid-cache.org/SquidFaq | |
109 | ||
110 | The Squid Configuration Manual http://www.squid-cache.org/Doc/config/ | |
ec1fac73 FC |
111 | |
112 | =cut | |
113 | ||
ec1fac73 FC |
114 | use Data::Dumper; |
115 | use Time::HiRes qw(gettimeofday tv_interval); | |
116 | ||
117 | # options handling | |
118 | my %opts = (); #for getopt | |
119 | my $debug = 0; #debug | |
120 | my $logfile = *STDERR; #filehandle to logfile | |
121 | my $logfilename; | |
122 | my $delay = 500; #in milliseconds. Configurable with the -w option. | |
123 | #for custom delay algorithms, you can customize the dispatch_request function | |
124 | ||
125 | #calculate the delay for the request. | |
126 | # Gets as input the verbatim full line received from squid | |
127 | # (channel number and all, as configured in squid.conf) and returns | |
128 | # a floating point number >= 0 which is the delay to be applied to the request | |
129 | # in seconds. | |
130 | # Notice that in order to have efficient data structures, the delay is | |
131 | # assumed to be monotonously growing. In other words, a long-delay | |
132 | # item will stall the queue until completed. Supporting generic delays | |
133 | # requires transforming @queue from a FIFO to a priority queue. | |
134 | sub calc_delay { | |
135 | return $delay; | |
136 | } | |
137 | ||
138 | GetOptions("debug|d" => \$debug, | |
139 | "wait|w=i" => \$delay, | |
140 | "log|l=s" => \$logfilename) | |
141 | or die("Error in parsing command line arguments"); | |
142 | if (defined $opts{h}) { | |
143 | HELP_MESSAGE(); | |
144 | exit 0; | |
145 | } | |
146 | $delay /= 1000.0; # transform msec into sec | |
147 | if ($logfilename) { | |
148 | open ($logfile,">>", "$opts{l}"); | |
149 | $debug=1; | |
150 | } | |
151 | ||
152 | my @p=split(/[\\\/]/,$0); | |
153 | my $prg_basename=pop @p; | |
154 | $prg_basename .= "[$$]"; | |
155 | undef @p; | |
156 | my $reqid=0; #sequence number for requests | |
157 | ||
158 | # variables initialization for select | |
159 | my $rvec = ''; | |
160 | vec($rvec,0,1) = 1; #stdin | |
161 | my ($nfound, $rd, $nread, $req); | |
162 | ||
163 | #requests queue | |
164 | my @queue = (); # array of references to hashes, with keys chan, when, req, reqid | |
165 | ||
166 | # signal handlers | |
167 | $SIG{HUP} = \&dump_state; | |
168 | ||
169 | #disable IO buffering | |
170 | $| = 1; | |
171 | my $fh=select($logfile); $|=1; select($fh); undef($fh); | |
172 | ||
173 | # takes a result from a gettimeofday call and turns it into a | |
174 | # floating-point number suitable for approximate time calculations and select | |
175 | sub fract_time { | |
176 | return $_[0]+$_[1]/1000000; | |
177 | } | |
178 | ||
179 | sub dispatch_request { | |
180 | my $r = $_[0]; | |
181 | chomp $r; | |
182 | &debug("got request: '$r'"); | |
183 | my %evt = (); | |
184 | my @fields; | |
185 | @fields = split (/\s+/, $r); | |
186 | $evt{when} = &calc_delay($r)+fract_time(gettimeofday()); | |
187 | $evt{reqid}=$reqid++; | |
188 | $evt{req} = $r; | |
189 | $evt{chan} = $fields[0]; | |
190 | &debug("Dispatching: reqid $evt{reqid}, chan $evt{chan}, when $evt{when}, raw {$evt{req}}"); | |
191 | push @queue,\%evt; | |
192 | } | |
193 | ||
194 | sub next_event { | |
195 | my $now = fract_time(gettimeofday()); | |
196 | if (@queue) { | |
197 | my $when = $queue[0]->{when} - $now; | |
198 | &debug("Next event is in $when seconds"); | |
199 | return $when; | |
200 | } | |
201 | &debug("No events in queue"); | |
202 | return undef; | |
203 | } | |
204 | ||
205 | sub handle_events { | |
206 | my $now = fract_time(gettimeofday()); | |
207 | while ( @queue ) { | |
208 | &debug("Queue length is $#queue"); | |
209 | last if ($queue[0]->{when} > $now); | |
210 | my %evt = %{shift @queue}; | |
211 | &debug("Event: reqid $evt{reqid}, chan $evt{chan}, when $evt{when}, raw {$evt{req}}"); | |
212 | print $evt{chan} , " OK\n"; | |
213 | } | |
214 | } | |
215 | ||
216 | # main loop | |
217 | while(1) { | |
218 | &debug("selecting"); | |
219 | $nfound = select($rd = $rvec,undef,undef,&next_event()); | |
220 | &debug("found $nfound bits set"); | |
221 | if ($nfound == -1 ) { | |
222 | next if ($!{ERESTART} || $!{EAGAIN} || $!{EINTR}); | |
223 | &debug("error in select: $!"); | |
224 | exit 1; | |
225 | } | |
226 | if (vec($rd,0,1)==1) { #got stuff from stdin | |
227 | my $d; #data | |
228 | $nread = sysread(STDIN,$d,40960); # read 40kb | |
229 | # clear the signal-bit, stdin is special | |
230 | vec($rd,0,1) = 0; | |
231 | if ($nread==0) { | |
232 | &debug("nothing read from stdin, exiting"); | |
233 | exit 0; | |
234 | } | |
235 | my $i; | |
236 | while ($i = index($d,"\n")) { #BUG: assumption of no spill-over | |
237 | last if ($i == -1); | |
238 | &dispatch_request(substr($d,0,$i)); | |
239 | $d=substr($d,$i+1); | |
240 | } | |
241 | } | |
242 | &handle_events(); | |
243 | } | |
244 | ||
245 | my $doc = <<_EOF; | |
246 | delay-adding external acl helper | |
247 | authorizes all requests, adding a delay before doing so. | |
248 | supports multiplexed helper protocol. | |
249 | Options: | |
250 | -h, --help: this help message | |
251 | -d, --debug: enable debug output | |
252 | -l <file>, --log <file>: log output to named file instead of stderr (implies debug) | |
253 | -w <num>, --wait <num> delay each request by this number milliseconds | |
254 | ||
255 | AUTHOR: Francesco Chemolli <kinkie\@squid-cache.org> | |
256 | Licensed under the terms of the GNU GPL v2 or later (see source for details) | |
257 | _EOF | |
258 | our $VERSION = "1.0"; | |
259 | ||
260 | sub HELP_MESSAGE { | |
261 | print STDERR $doc; | |
262 | } | |
263 | ||
264 | sub dump_state { | |
265 | $SIG{HUP} = \&dump_state; | |
266 | print STDERR "Queue:\n",Dumper(\@queue),"\n"; | |
267 | } | |
268 | ||
269 | sub debug { | |
270 | return unless ($debug); | |
271 | print $logfile $prg_basename , ": ", @_, "\n"; | |
272 | } |