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