]>
Commit | Line | Data |
---|---|---|
e83fd259 | 1 | #!/usr/bin/perl -w |
a151895d | 2 | # |
f70aedc4 | 3 | ## Copyright (C) 1996-2021 The Squid Software Foundation and contributors |
a151895d AJ |
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 | ## | |
e83fd259 | 9 | |
2f8abb64 | 10 | # Reads cache.log from STDIN, preferably with full debugging enabled. |
e83fd259 AR |
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 = ( | |
47f28373 FC |
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 | 'cbdataInternalAlloc: Allocating (\S+)', | |
59 | 'cbdataRealFree: 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 | ); | |
e83fd259 AR |
74 | |
75 | if (!$Pairs{$Thing}) { | |
76 | warn("guessing construction/destruction pattern for $Thing\n"); | |
77 | $Pairs{$Thing} = [ | |
47f28373 FC |
78 | "\\b$Thing construct.*, this=(\\S+)", |
79 | "\\b$Thing destruct.*, this=(\\S+)", | |
80 | ]; | |
e83fd259 AR |
81 | } |
82 | ||
83 | die("unsupported Thing, stopped") unless $Pairs{$Thing}; | |
84 | ||
85 | my $reConstructor = $Pairs{$Thing}->[0]; | |
86 | my $reDestructor = $Pairs{$Thing}->[1]; | |
87 | ||
01aed79c AR |
88 | my %AliveCount = (); |
89 | my %AliveImage = (); | |
e83fd259 AR |
90 | my $Count = 0; |
91 | while (<STDIN>) { | |
47f28373 FC |
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 | if ($AliveCount{$id}) { | |
101 | $AliveImage{$id} = undef() unless --$AliveCount{$id}; | |
102 | } else { | |
103 | #warn("unborn: $_"); | |
104 | # do nothing; we are probably looking at a partial log | |
105 | } | |
106 | } | |
e83fd259 AR |
107 | } |
108 | ||
109 | printf(STDERR "Found %d %s\n", $Count, $Thing); | |
110 | ||
01aed79c AR |
111 | my $aliveCount = 0; |
112 | foreach my $alive (sort grep { defined($_) } values %AliveImage) { | |
47f28373 FC |
113 | next unless defined $alive; |
114 | printf("Alive: %s", $alive); | |
115 | ++$aliveCount; | |
e83fd259 AR |
116 | } |
117 | ||
01aed79c | 118 | printf(STDERR "found %d still-alive %s\n", $aliveCount, $Thing); |
e83fd259 AR |
119 | |
120 | exit(0); |