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