scripts/cachetrace.pl

   1 #!/usr/local/bin/perl
   2 #
   3 ## Copyright (C) 1996-2017 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 require 'sys/socket.ph';
  11
  12 $url = shift || die "usage: $0: url\n";
  13 $proxy = 'localhost';
  14 $port = 3128;
  15
  16 $url = "http://$url/" if ($url =~ /^[-\w\.]+$/);
  17 print "Querying cache path to $url\n";
  18 $host = $1 if ($url =~ /^[^:]+:\/\/([^\/:]+)/);
  19
  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);
  25
  26 &try_http_11($url);
  27
  28
  29 sub try_http_11 {
  30         local($url) = @_;
  31         local($path) = undef;
  32
  33         $source = $1 if ($url =~ /^[^:]+:\/\/([^:\/]+)/);
  34
  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;
  42         select (STDOUT);
  43         print SOCK "TRACE $url HTTP/1.1\r\nHost: $host\r\nAccept: */*\r\n\r\n";
  44         while (<SOCK>) {
  45                 s/\r//g;
  46                 s/\n//g;
  47                 $code = $1 if (/^HTTP\/\d\.\d (\d+)/);
  48                 $server = $1 if (/^Server:\s*(.*)$/);
  49                 $path = $1 if (/^Via:\s*(.*)$/);
  50         }
  51         return 0 unless ($path && $code == 200);
  52         print "Received TRACE reply from $source\n";
  53         @F = split(',', $path);
  54         $i = 0;
  55         foreach $n (@F) {
  56                 $n =~ s/^\s+//;
  57                 printf " %2d   %s\n", ++$i, $n;
  58         }
  59         printf " %2d   %s (%s)\n", ++$i, $source, $server;
  60         1;
  61 }