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