1#!/usr/local/bin/perl 2# 3## Copyright (C) 1996-2021 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 31require 'sys/socket.ph'; 32$gettimeofday = 1128; # cheating, should use require syscall.ph 33 34while (<>) { 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 63print "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 71exit 0; 72 73sub 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 99sub 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 109sub 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 156sub gettimeofday { 157 $tvp="\0\0\0\0\0\0\0\0"; 158 syscall($gettimeofday, $tvp, $tz); 159 return unpack('ll', $tvp); 160} 161 162