src/acl/external/delayer/ext_delayer_acl.pl.in

   1 #!@PERL@
   2
   3 use strict;
   4 use warnings;
   5 use Getopt::Long qw(:config auto_version auto_help);
   6 use Pod::Usage;
   7
   8 =pod
   9
  10 =head1 NAME
  11
  12  delayer - Squid external ACL helper adding artificial delay to requests
  13
  14 =head1 SYNOPSIS
  15
  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".
  25
  26 =head1 OPTIONS
  27
  28 =over 12
  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
  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
  77  * Copyright (C) 1996-2020 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
  83  (C) 2014 Francesco Chemolli <kinkie@squid-cache.org>
  84
  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.
  88
  89 =head1 QUESTIONS
  90
  91 Questions on the usage of this program can be sent to the I<Squid Users mailing list <squid-users@lists.squid-cache.org>>
  92
  93 =head1 REPORTING BUGS
  94
  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.
  97
  98 Report bugs or bug fixes using http://bugs.squid-cache.org/
  99
 100 Report serious security bugs to I<Squid Bugs <squid-bugs@lists.squid-cache.org>>
 101
 102 Report ideas for new improvements to the I<Squid Developers mailing list <squid-dev@lists.squid-cache.org>>
 103
 104 =head1 SEE ALSO
 105
 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/
 111
 112 =cut
 113
 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 }