--- /dev/null
+#!@PERL@
+=pod
+
+=head1 NAME
+
+delayer - Squid external acl helper adding artificial delay to requests
+
+=head1 SYNOPSIS
+
+delayer [--help] [--debug] [--log file] [--wait msec]
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<--help> or B<-h>
+
+Print help message to stdout
+
+=item B<--debug> or B<-d>
+
+Emit debugging output to STDERR and ultimately cache.log
+
+=item B<--log /path/to/file> or B<-l /path/to/file>
+
+Emit debugging output to specified file instead of STDERR. Also turns on debugging
+
+=item B<--wait msec> or B<-w msec>
+
+Delay each request by the specified amount of msec.
+Unless this option is specified, by default each submitted request
+will be delayed by half a second (500 msec).
+
+=back
+
+=head1 DESCRIPTION
+
+Squid external acl helper; causes squid to delay responding to HTTP requests.
+
+By carefully crafting the ACLs of a Squid setup it is possible to
+selectively delay requests received by a proxy. After the configured amount
+of time, it will always return "true".
+
+=head1 CONFIGURATION
+
+To engage it, this snippet of configuration template can be used in squid.conf:
+
+ external_acl_type delayer concurrency=100000 children-max=2 children-startup=1 children-idle=1 cache=10 %URI /path/to/delayer -w 200
+ acl delay external delayer
+ http_access allow acl1 acl2 acl3 delay !all
+
+It is important that the acl referencing the delayer be the penultimate clause in the
+http_access line. It will cause delay to all requests that match all the
+preceding acls in the line. The !all clause at the end of the line will make it
+so that no traffic is authorized by this ACL, only the delay to evaluate
+the delay clause will be inserted before evaluating following http_access lines.
+It is also important to place the http_access line carefully in the sequence
+of all http_access_lines; it should be near the beginning, but be careful
+not to insert unwanted slow acls (especially proxy_auth).
+
+It is possible to customize how delay is calculated for each request by
+modifying the "calc_delay" PERL function in the script, documentation on this
+is embedded in the source code comments.
+
+=head1 AUTHOR
+
+This software is written by Francesco Chemolli <kinkie@squid-cache.org>
+
+=head1 COPYRIGHT
+
+(C) 2014 Francesco Chemolli <kinkie@squid-cache.org>
+
+This program is free software. You may redistribute copies of it under the
+terms of the GNU General Public License version 2, or (at your opinion) any
+later version.
+
+=head1 QUESTIONS
+
+Questions on this code are best addressed on the Squid-users mailing list
+<squid-users@squid-cache.org>
+
+=head1 REPORTING BUGS
+
+Bug reports need to be made in English.
+See http://wiki.squid-cache.org/SquidFaq/BugReporting for details of what you
+need to include with your bug report.
+Report bugs or bug fixes using http://bugs.squid-cache.org/
+
+=head1 SEE ALSO
+
+B<squid>(8), B<GPL>(7), B<Squid Wiki> http://wiki.squid-cache.org/ ,
+B<Squid Configuration Manual> http://www.squid-cache.org/Doc/config/
+
+=cut
+
+use strict;
+use warnings;
+use Getopt::Long qw(:config auto_version auto_help);
+use Data::Dumper;
+use Time::HiRes qw(gettimeofday tv_interval);
+
+# options handling
+my %opts = (); #for getopt
+my $debug = 0; #debug
+my $logfile = *STDERR; #filehandle to logfile
+my $logfilename;
+my $delay = 500; #in milliseconds. Configurable with the -w option.
+#for custom delay algorithms, you can customize the dispatch_request function
+
+#calculate the delay for the request.
+# Gets as input the verbatim full line received from squid
+# (channel number and all, as configured in squid.conf) and returns
+# a floating point number >= 0 which is the delay to be applied to the request
+# in seconds.
+# Notice that in order to have efficient data structures, the delay is
+# assumed to be monotonously growing. In other words, a long-delay
+# item will stall the queue until completed. Supporting generic delays
+# requires transforming @queue from a FIFO to a priority queue.
+sub calc_delay {
+ return $delay;
+}
+
+GetOptions("debug|d" => \$debug,
+ "wait|w=i" => \$delay,
+ "log|l=s" => \$logfilename)
+or die("Error in parsing command line arguments");
+if (defined $opts{h}) {
+ HELP_MESSAGE();
+ exit 0;
+}
+$delay /= 1000.0; # transform msec into sec
+if ($logfilename) {
+ open ($logfile,">>", "$opts{l}");
+ $debug=1;
+}
+
+my @p=split(/[\\\/]/,$0);
+my $prg_basename=pop @p;
+$prg_basename .= "[$$]";
+undef @p;
+my $reqid=0; #sequence number for requests
+
+# variables initialization for select
+my $rvec = '';
+vec($rvec,0,1) = 1; #stdin
+my ($nfound, $rd, $nread, $req);
+
+#requests queue
+my @queue = (); # array of references to hashes, with keys chan, when, req, reqid
+
+# signal handlers
+$SIG{HUP} = \&dump_state;
+
+#disable IO buffering
+$| = 1;
+my $fh=select($logfile); $|=1; select($fh); undef($fh);
+
+# takes a result from a gettimeofday call and turns it into a
+# floating-point number suitable for approximate time calculations and select
+sub fract_time {
+ return $_[0]+$_[1]/1000000;
+}
+
+sub dispatch_request {
+ my $r = $_[0];
+ chomp $r;
+ &debug("got request: '$r'");
+ my %evt = ();
+ my @fields;
+ @fields = split (/\s+/, $r);
+ $evt{when} = &calc_delay($r)+fract_time(gettimeofday());
+ $evt{reqid}=$reqid++;
+ $evt{req} = $r;
+ $evt{chan} = $fields[0];
+ &debug("Dispatching: reqid $evt{reqid}, chan $evt{chan}, when $evt{when}, raw {$evt{req}}");
+ push @queue,\%evt;
+}
+
+sub next_event {
+ my $now = fract_time(gettimeofday());
+ if (@queue) {
+ my $when = $queue[0]->{when} - $now;
+ &debug("Next event is in $when seconds");
+ return $when;
+ }
+ &debug("No events in queue");
+ return undef;
+}
+
+sub handle_events {
+ my $now = fract_time(gettimeofday());
+ while ( @queue ) {
+ &debug("Queue length is $#queue");
+ last if ($queue[0]->{when} > $now);
+ my %evt = %{shift @queue};
+ &debug("Event: reqid $evt{reqid}, chan $evt{chan}, when $evt{when}, raw {$evt{req}}");
+ print $evt{chan} , " OK\n";
+ }
+}
+
+# main loop
+while(1) {
+ &debug("selecting");
+ $nfound = select($rd = $rvec,undef,undef,&next_event());
+ &debug("found $nfound bits set");
+ if ($nfound == -1 ) {
+ next if ($!{ERESTART} || $!{EAGAIN} || $!{EINTR});
+ &debug("error in select: $!");
+ exit 1;
+ }
+ if (vec($rd,0,1)==1) { #got stuff from stdin
+ my $d; #data
+ $nread = sysread(STDIN,$d,40960); # read 40kb
+ # clear the signal-bit, stdin is special
+ vec($rd,0,1) = 0;
+ if ($nread==0) {
+ &debug("nothing read from stdin, exiting");
+ exit 0;
+ }
+ my $i;
+ while ($i = index($d,"\n")) { #BUG: assumption of no spill-over
+ last if ($i == -1);
+ &dispatch_request(substr($d,0,$i));
+ $d=substr($d,$i+1);
+ }
+ }
+ &handle_events();
+}
+
+my $doc = <<_EOF;
+delay-adding external acl helper
+authorizes all requests, adding a delay before doing so.
+supports multiplexed helper protocol.
+Options:
+ -h, --help: this help message
+ -d, --debug: enable debug output
+ -l <file>, --log <file>: log output to named file instead of stderr (implies debug)
+ -w <num>, --wait <num> delay each request by this number milliseconds
+
+AUTHOR: Francesco Chemolli <kinkie\@squid-cache.org>
+Licensed under the terms of the GNU GPL v2 or later (see source for details)
+_EOF
+our $VERSION = "1.0";
+
+sub HELP_MESSAGE {
+ print STDERR $doc;
+}
+
+sub dump_state {
+ $SIG{HUP} = \&dump_state;
+ print STDERR "Queue:\n",Dumper(\@queue),"\n";
+}
+
+sub debug {
+ return unless ($debug);
+ print $logfile $prg_basename , ": ", @_, "\n";
+}
projects / thirdparty / squid.git / commitdiff
