scripts/flag_truncs.pl

   1 #!/usr/local/bin/perl
   2 #
   3 ## Copyright (C) 1996-2018 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 # flag_truncs.pl - martin hamilton <m.t.hamilton@lut.ac.uk>
  11 #
  12 # Check the CERN/Harvest/Netscape cache for truncated objects
  13 # - i.e. those for which there is a "Content-length:" HTTP header,
  14 #   and this does not match the size of the cached object
  15
  16 require "getopts.pl";
  17 require "stat.pl";
  18 &Getopts("cd");
  19 # -c -> just count the number of objects with a Content-length header
  20 # -d -> turn on debugging output
  21
  22 # pass filenames on command line or via STDIN
  23 @things = $#ARGV >= 0 ? @ARGV : <STDIN>;
  24
  25 $total_objects = 0, $content_length = 0;
  26
  27 # iterate through them
  28 foreach $thing (@things) {
  29   chop $thing;
  30
  31   $opt_d && (print STDERR ">> inspecting: $thing\n");
  32   next if -d "$thing"; # don't want directories
  33
  34   $size = (stat($thing))[$ST_SIZE]||next;
  35   $opt_d && (print STDERR ">> stat: $size\n");
  36   print "$thing\n", next if ($size == 0);
  37
  38   $total_objects++;
  39
  40   $count = 0, $expected = 0;
  41   open(IN, "$thing") || die "Can't open cached object $thing: $!";
  42   while(<IN>) {
  43     $count += length($_);
  44     chop;
  45     print STDERR ">> inspecting $_\n" if $opt_d;
  46     last if /^(\s+|)$/; # drop out after the end of the HTTP headers
  47
  48     # skip if cached file appeared since script started running
  49     if (-M $_ < 0) {
  50       print STDERR ">> skipping $_\n" if $opt_d;
  51       next;
  52     }
  53
  54     if (/^Content-length:\s+(\d+)/i) {
  55       $expected = $1;
  56       $content_length++;
  57     }
  58   }
  59   close(IN);
  60
  61   next if $opt_c;
  62   next if $expected == 0; # no Content-length header
  63
  64   # looked at the headers now
  65   $difference = $size - $count;
  66   $opt_d && print STDERR ">> real: ", $difference, ", expected: $expected\n";
  67   if ($difference != $expected) {
  68     print "$thing (expected: $expected, got: $difference)\n";
  69   }
  70 }
  71
  72 print "$content_length out of $total_objects had Content-length: header\n"
  73   if $opt_c;