]>
git.ipfire.org Git - thirdparty/squid.git/blob - scripts/cachetrace.pl
3 ## Copyright (C) 1996-2021 The Squid Software Foundation and contributors
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.
10 require 'sys/socket.ph';
12 $url = shift || die "usage: $0: url\n";
16 $url = "http://$url/" if ($url =~ /^[-\w\
.]+$/);
17 print "Querying cache path to $url\n";
18 $host = $1 if ($url =~ /^[^:]+:\/\
/([^\/:]+)/);
20 $sockaddr = 'S n a4 x8';
21 ($name, $aliases, $proto) = getprotobyname("tcp");
22 ($fqdn, $aliases, $type, $len, $thataddr) = gethostbyname($proxy);
23 $thissock = pack($sockaddr, &AF_INET
, 0, "\0\0\0\0");
24 $that = pack($sockaddr, &AF_INET
, $port, $thataddr);
33 $source = $1 if ($url =~ /^[^:]+:\/\
/([^:\/]+)/);
35 die "socket: $!\n" unless
36 socket (SOCK
, &AF_INET
, &SOCK_STREAM
, $proto);
37 die "bind: $!\n" unless
38 bind (SOCK
, $thissock);
39 die "$proxy:$port: $!\n" unless
40 connect (SOCK
, $that);
41 select (SOCK
); $| = 1;
43 print SOCK
"TRACE $url HTTP/1.1\r\nHost: $host\r\nAccept: */*\r\n\r\n";
47 $code = $1 if (/^HTTP\/\d\
.\d
(\d
+)/);
48 $server = $1 if (/^Server:\s*(.*)$/);
49 $path = $1 if (/^Via:\s*(.*)$/);
51 return 0 unless ($path && $code == 200);
52 print "Received TRACE reply from $source\n";
53 @F = split(',', $path);
57 printf " %2d %s\n", ++$i, $n;
59 printf " %2d %s (%s)\n", ++$i, $source, $server;