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