scripts/find-alive.pl

   1 #!/usr/bin/perl -w
   2 #
   3 ## Copyright (C) 1996-2015 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 # Reads cache.log from STDIN, preferrably with full debugging enabled.
  11 # Finds creation and destruction messages for a given class.
  12 # At the end, reports log lines that correspond to still-alive objects.
  13 # Also reports the number of objects found (total and still-alive).
  14 #
  15 # Many classes have unique creation/destruction line patterns so we
  16 # have to hard-code those patterns in the %Pairs table below. That
  17 # table usually contains a few outdated entries.
  18
  19 use strict;
  20 use warnings;
  21
  22 my $Thing = $ARGV[0] or die("usage: $0 <Thing-to-look-for>\n");
  23
  24 # When creation and destriction messages are standardizes, we
  25 # will be able to support any class without this hard-coded table.
  26 # We try to do that now (see "guessing ..." below), but it does
  27 # not always work.
  28 my %Pairs = (
  29         AsyncCall => [
  30                 'AsyncCall.* constructed, this=(\S+)',
  31                 'AsyncCall.* destruct.*, this=(\S+)',
  32         ],
  33         HttpHeaderEntry => [
  34                 '\bHttpHeaderEntry.* created HttpHeaderEntry (\S+)',
  35                 '\bHttpHeaderEntry.* destroying entry (\S+)',
  36         ],
  37         ClientSocketContext => [
  38                 '\bClientSocketContext constructing, this=(\S+)',
  39                 '\bClientSocketContext destructed, this=(\S+)',
  40         ],
  41         ICAP => [
  42                 '(?:ICAP|Icap).* constructed, this=(\S+)',
  43                 '(?:ICAP|Icap).* destruct.*, this=(\S+)',
  44         ],
  45         IcapModXact => [
  46                 'Adaptation::Icap::ModXact.* constructed, this=(\S+)',
  47                 'Adaptation::Icap::ModXact.* destruct.*, this=(\S+)',
  48         ],
  49         ICAPClientReqmodPrecache => [
  50                 'ICAPClientReqmodPrecache constructed, this=(\S+)',
  51                 'ICAPClientReqmodPrecache destruct.*, this=(\S+)',
  52         ],
  53         HttpStateData => [
  54                 'HttpStateData (\S+) created',
  55                 'HttpStateData (\S+) destroyed',
  56         ],
  57         cbdata => [
  58                 'cbdataAlloc: (\S+)',
  59                 '(?:cbdataFree|cbdataUnlock): Freeing (\S+)',
  60         ],
  61         FD => [
  62                 'fd_open.*\sFD (\d+)',
  63                 'fd_close\s+FD (\d+)',
  64         ],
  65         IpcStoreMapEntry => [
  66                 'StoreMap.* opened .*entry (\d+) for \S+ (\S+)',
  67                 'StoreMap.* closed .*entry (\d+) for \S+ (\S+)',
  68         ],
  69         sh_page => [
  70                 'PageStack.* pop: (sh_page\S+) at',
  71                 'PageStack.* push: (sh_page\S+) at',
  72         ],
  73 );
  74
  75 if (!$Pairs{$Thing}) {
  76     warn("guessing construction/destruction pattern for $Thing\n");
  77     $Pairs{$Thing} = [
  78                 "\\b$Thing construct.*, this=(\\S+)",
  79                 "\\b$Thing destruct.*, this=(\\S+)",
  80         ];
  81 }
  82
  83 die("unsupported Thing, stopped") unless $Pairs{$Thing};
  84
  85 my $reConstructor = $Pairs{$Thing}->[0];
  86 my $reDestructor = $Pairs{$Thing}->[1];
  87
  88 my %AliveCount = ();
  89 my %AliveImage = ();
  90 my $Count = 0;
  91 while (<STDIN>) {
  92         if (my @conIds = (/$reConstructor/)) {
  93                 my $id = join(':', @conIds);
  94                 #die($_) if $Alive{$id};
  95                 $AliveImage{$id} = $_;
  96                 ++$Count unless $AliveCount{$id}++;
  97         }
  98         elsif (my @deIds = (/$reDestructor/)) {
  99                 my $id = join(':', @deIds);
 100                 #warn("unborn: $_") unless $AliveCount{$id};
 101                 $AliveImage{$id} = undef() unless --$AliveCount{$id};
 102         }
 103 }
 104
 105 printf(STDERR "Found %d %s\n", $Count, $Thing);
 106
 107 my $aliveCount = 0;
 108 foreach my $alive (sort grep { defined($_) } values %AliveImage) {
 109         next unless defined $alive;
 110         printf("Alive: %s", $alive);
 111         ++$aliveCount;
 112 }
 113
 114 printf(STDERR "found %d still-alive %s\n", $aliveCount, $Thing);
 115
 116 exit(0);