5 use Getopt
::Long
qw(:config auto_version auto_help);
12 delayer - Squid external ACL helper adding artificial delay to requests
16 delayer [--help] [--debug] [--log file] [--wait msec]
20 Squid external acl helper; causes squid to delay responding to HTTP requests.
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".
30 =item B<--help> or B<-h>
32 Print help message to stdout
34 =item B<--debug> or B<-d>
36 Emit debugging output to STDERR and ultimately cache.log
38 =item B<--log /path/to/file> or B<-l /path/to/file>
40 Emit debugging output to specified file instead of STDERR. Also turns on debugging
42 =item B<--wait msec> or B<-w msec>
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).
52 To engage it, this snippet of configuration template can be used in squid.conf:
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
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).
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.
73 This software is written by Francesco Chemolli <kinkie@squid-cache.org>
77 * Copyright (C) 1996-2017 The Squid Software Foundation and contributors
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.
83 (C) 2014 Francesco Chemolli <kinkie@squid-cache.org>
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
91 Questions on the usage of this program can be sent to the I<Squid Users mailing list <squid-users@squid-cache.org>>
95 Bug reports need to be made in English.
96 See http://wiki.squid-cache.org/SquidFaq/BugReporting for details of what you need to include with your bug report.
98 Report bugs or bug fixes using http://bugs.squid-cache.org/
100 Report serious security bugs to I<Squid Bugs <squid-bugs@squid-cache.org>>
102 Report ideas for new improvements to the I<Squid Developers mailing list <squid-dev@squid-cache.org>>
108 The Squid FAQ wiki http://wiki.squid-cache.org/SquidFaq
110 The Squid Configuration Manual http://www.squid-cache.org/Doc/config/
115 use Time
::HiRes
qw(gettimeofday tv_interval);
118 my %opts = (); #for getopt
119 my $debug = 0; #debug
120 my $logfile = *STDERR
; #filehandle to logfile
122 my $delay = 500; #in milliseconds. Configurable with the -w option.
123 #for custom delay algorithms, you can customize the dispatch_request function
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
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.
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
}) {
146 $delay /= 1000.0; # transform msec into sec
148 open ($logfile,">>", "$opts{l}");
152 my @p=split(/[\\\/]/,$0);
153 my $prg_basename=pop @p;
154 $prg_basename .= "[$$]";
156 my $reqid=0; #sequence number for requests
158 # variables initialization for select
160 vec($rvec,0,1) = 1; #stdin
161 my ($nfound, $rd, $nread, $req);
164 my @queue = (); # array of references to hashes, with keys chan, when, req, reqid
167 $SIG{HUP
} = \
&dump_state
;
169 #disable IO buffering
171 my $fh=select($logfile); $|=1; select($fh); undef($fh);
173 # takes a result from a gettimeofday call and turns it into a
174 # floating-point number suitable for approximate time calculations and select
176 return $_[0]+$_[1]/1000000;
179 sub dispatch_request
{
182 &debug
("got request: '$r'");
185 @fields = split (/\s+/, $r);
186 $evt{when} = &calc_delay
($r)+fract_time
(gettimeofday
());
187 $evt{reqid
}=$reqid++;
189 $evt{chan
} = $fields[0];
190 &debug
("Dispatching: reqid $evt{reqid}, chan $evt{chan}, when $evt{when}, raw {$evt{req}}");
195 my $now = fract_time
(gettimeofday
());
197 my $when = $queue[0]->{when} - $now;
198 &debug
("Next event is in $when seconds");
201 &debug
("No events in queue");
206 my $now = fract_time
(gettimeofday
());
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";
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: $!");
226 if (vec($rd,0,1)==1) { #got stuff from stdin
228 $nread = sysread(STDIN
,$d,40960); # read 40kb
229 # clear the signal-bit, stdin is special
232 &debug
("nothing read from stdin, exiting");
236 while ($i = index($d,"\n")) { #BUG: assumption of no spill-over
238 &dispatch_request
(substr($d,0,$i));
246 delay
-adding external acl helper
247 authorizes all requests
, adding a delay before doing so
.
248 supports multiplexed helper protocol
.
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
255 AUTHOR
: Francesco Chemolli
<kinkie\
@squid-cache
.org
>
256 Licensed under the terms of the GNU GPL v2
or later
(see source
for details
)
258 our $VERSION = "1.0";
265 $SIG{HUP
} = \
&dump_state
;
266 print STDERR
"Queue:\n",Dumper
(\
@queue),"\n";
270 return unless ($debug);
271 print $logfile $prg_basename , ": ", @_, "\n";