scripts/cachetrace.pl

   1 #!/usr/local/bin/perl
   2
   3 require 'sys/socket.ph';
   4
   5 $url = shift || die "usage: $0: url\n";
   6 $proxy = 'localhost';
   7 $port = 3128;
   8
   9 $url = "http://$url/" if ($url =~ /^[-\w\.]+$/);
  10 print "Querying cache path to $url\n";
  11 $host = $1 if ($url =~ /^[^:]+:\/\/([^\/:])+/);
  12
  13 $sockaddr = 'S n a4 x8';
  14 ($name, $aliases, $proto) = getprotobyname("tcp");
  15 ($fqdn, $aliases, $type, $len, $thataddr) = gethostbyname($proxy);
  16 $thissock = pack($sockaddr, &AF_INET, 0, "\0\0\0\0");
  17 $that = pack($sockaddr, &AF_INET, $port, $thataddr);
  18
  19 &try_http_11($url);
  20
  21
  22 sub try_http_11 {
  23         local($url) = @_;
  24         local($path) = undef;
  25
  26         $source = $1 if ($url =~ /^[^:]+:\/\/([^:\/]+)/);
  27
  28         die "socket: $!\n" unless
  29                 socket (SOCK, &AF_INET, &SOCK_STREAM, $proto);
  30         die "bind: $!\n" unless
  31                 bind (SOCK, $thissock);
  32         die "$proxy:$port: $!\n" unless
  33                 connect (SOCK, $that);
  34         select (SOCK); $| = 1;
  35         select (STDOUT);
  36         print SOCK "TRACE $url HTTP/1.1\r\nHost: $host\r\nAccept: */*\r\n\r\n";
  37         while (<SOCK>) {
  38                 s/\r//g;
  39                 s/\n//g;
  40                 $code = $1 if (/^HTTP\/\d\.\d (\d+)/);
  41                 $server = $1 if (/^Server:\s*(.*)$/);
  42                 $path = $1 if (/^Via:\s*(.*)$/);
  43         }
  44         return 0 unless ($path && $code == 200);
  45         print "Received TRACE reply from $source\n";
  46         @F = split(',', $path);
  47         $i = 0;
  48         foreach $n (@F) {
  49                 $n =~ s/^\s+//;
  50                 printf " %2d   %s\n", ++$i, $n;
  51         }
  52         printf " %2d   %s (%s)\n", ++$i, $source, $server;
  53         1;
  54 }