scripts/cache-compare.pl

   1 #!/usr/local/bin/perl
   2 #
   3 ## Copyright (C) 1996-2020 The Squid Software Foundation and contributors
   4 ##
   5 ## Squid software is distributed under GPLv2+ license and includes
   6 ## contributions from numerous individuals and organizations.
   7 ## Please see the COPYING and CONTRIBUTORS files for details.
   8 ##
   9
  10 # cache-compare.pl
  11 #
  12 # Duane Wessels, Dec 1995
  13 #
  14 # A simple perl script to compare how long it takes to fetch an object
  15 # from a number of different caches.
  16 #
  17 # stdin is a list of URLs.  Set the @getfrom array to a list of caches
  18 # to fetch each URL from.  Include 'SOURCE' in @getfrom to fetch from
  19 # the source host also.  For each URL, print the byte count, elapsed
  20 # time and average data rate.  At the end print out some averages.
  21 #
  22 # NOTE: uses the Perl function syscall() to implement gettimeofday(2).
  23 # Assumes that gettimeofday is syscall #116 on the system
  24 # (see /usr/include/sys/syscall.h).
  25 #
  26 # BUGS:
  27 # Should probably cache the gethostbyname() calls.
  28
  29 @getfrom = ('SOURCE', 'localhost:3128', 'bo:3128');
  30
  31 require 'sys/socket.ph';
  32 $gettimeofday = 1128;           # cheating, should use require syscall.ph
  33
  34 while (<>) {
  35         chop ($url = $_);
  36         print "$url:\n";
  37
  38         foreach $k (@getfrom) {
  39                 printf "%30.30s:\t", $k;
  40                 if ($k eq 'SOURCE') {
  41                         ($b_sec,$b_usec) = &gettimeofday;
  42                         $n = &get_from_source($url);
  43                         ($e_sec,$e_usec) = &gettimeofday;
  44                 } else {
  45                         ($host,$port) = split (':', $k);
  46                         ($b_sec,$b_usec) = &gettimeofday;
  47                         $n = &get_from_cache($host,$port,$url);
  48                         ($e_sec,$e_usec) = &gettimeofday;
  49                 }
  50                 next unless ($n > 0);
  51                 $d = ($e_sec - $b_sec) * 1000000 + ($e_usec - $b_usec);
  52                 $d /= 1000000;
  53                 $r = $n / $d;
  54                 printf "%8.1f b/s (%7d bytes, %7.3f sec)\n",
  55                         $r, $n, $d;
  56                 $bps_sum{$k} += $r;
  57                 $bps_n{$k}++;
  58                 $bytes_sum{$k} += $n;
  59                 $sec_sum{$k} += $d;
  60         }
  61 }
  62
  63 print "AVERAGE b/s rates:\n";
  64         foreach $k (@getfrom) {
  65         printf "%30.30s:\t%8.1f b/s   (Alt: %8.1f b/s)\n",
  66                 $k,
  67                 $bps_sum{$k} / $bps_n{$k},
  68                 $bytes_sum{$k} / $sec_sum{$k};
  69 }
  70
  71 exit 0;
  72
  73 sub get_from_source {
  74         local($url) = @_;
  75         local($bytes) = 0;
  76         unless ($url =~ m!([a-z]+)://([^/]+)(.*)$!) {
  77                 printf "get_from_source: bad URL\n";
  78                 return 0;
  79         }
  80         $proto = $1;
  81         $host = $2;
  82         $url_path = $3;
  83         unless ($proto eq 'http') {
  84                 printf "get_from_source: I only do HTTP\n";
  85                 return 0;
  86         }
  87         $port = 80;
  88         if ($host =~ /([^:]+):(\d+)/) {
  89                 $host = $1;
  90                 $port = $2;
  91         }
  92         return 0 unless ($SOCK = &client_socket($host,$port));
  93         print $SOCK "GET $url_path HTTP/1.0\r\nAccept */*\r\n\r\n";
  94         $bytes += $n while (($n = read(SOCK,$_,4096)) > 0);
  95         close $SOCK;
  96         return $bytes;
  97 }
  98
  99 sub get_from_cache {
 100         local($host,$port,$url) = @_;
 101         local($bytes) = 0;
 102         return 0 unless ($SOCK = &client_socket($host,$port));
 103         print $SOCK "GET $url HTTP/1.0\r\nAccept */*\r\n\r\n";
 104         $bytes += $n while (($n = read(SOCK,$_,4096)) > 0);
 105         close $SOCK;
 106         return $bytes;
 107 }
 108
 109 sub client_socket {
 110         local ($host, $port) = @_;
 111         local ($sockaddr) = 'S n a4 x8';
 112         local ($name, $aliases, $proto) = getprotobyname('tcp');
 113         local ($connected) = 0;
 114
 115         # Lookup addresses for remote hostname
 116         #
 117         local($w,$x,$y,$z,@thataddrs) = gethostbyname($host);
 118         unless (@thataddrs) {
 119                 printf "Unknown Host: $host\n";
 120                 return ();
 121         }
 122
 123         # bind local socket to INADDR_ANY
 124         #
 125         local ($thissock) = pack($sockaddr, &AF_INET, 0, "\0\0\0\0");
 126         unless (socket (SOCK, &AF_INET, &SOCK_STREAM, $proto)) {
 127                 printf  "socket: $!\n";
 128                 return ();
 129         }
 130         unless (bind (SOCK, $thissock)) {
 131                 printf "bind: $!\n";
 132                 return ();
 133         }
 134
 135         # Try all addresses
 136         #
 137         foreach $thataddr (@thataddrs) {
 138                 local ($that) = pack($sockaddr, &AF_INET, $port, $thataddr);
 139                 if (connect (SOCK, $that)) {
 140                         $connected = 1;
 141                         last;
 142                 }
 143         }
 144         unless ($connected) {
 145                 printf "$host:$port: $!\n";
 146                 return ();
 147         }
 148
 149         # Set socket to flush-after-write and return it
 150         #
 151         select (SOCK); $| = 1;
 152         select (STDOUT);
 153         return (SOCK);
 154 }
 155
 156 sub gettimeofday {
 157         $tvp="\0\0\0\0\0\0\0\0";
 158         syscall($gettimeofday, $tvp, $tz);
 159         return unpack('ll', $tvp);
 160 }
 161