From: Alex Rousskov Date: Fri, 16 Jul 2010 22:37:42 +0000 (-0600) Subject: Added debugging scripts that work with detailed cache.log X-Git-Tag: SQUID_3_2_0_1~53 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e83fd25;p=thirdparty%2Fsquid.git Added debugging scripts that work with detailed cache.log scripts/find-alive.pl: pinpoint objects that are still alive, to find leaks scripts/trace-job.pl: find cache.log lines that correspond to a given job scripts/trace-master.pl: trace jobs related to a single master transaction The scripts require maintenance as the logging format changes, but they often simplify debugging by extracting relevant information from tons of poorly structured cache.log data. --- diff --git a/scripts/Makefile.am b/scripts/Makefile.am index 427e524a06..92f73072c5 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -1,6 +1,7 @@ EXTRA_DIST = AnnounceCache.pl access-log-matrix.pl cache-compare.pl \ cachetrace.pl check_cache.pl convert.configure.to.os2 \ fileno-to-pathname.pl flag_truncs.pl icp-test.pl \ + find-alive.pl trace-job.pl trace-master.pl \ icpserver.pl tcp-banger.pl udp-banger.pl upgrade-1.0-store.pl dist_noinst_SCRIPTS = remove-cfg.sh diff --git a/scripts/find-alive.pl b/scripts/find-alive.pl new file mode 100755 index 0000000000..d32b403c54 --- /dev/null +++ b/scripts/find-alive.pl @@ -0,0 +1,94 @@ +#!/usr/bin/perl -w + +# Reads cache.log from STDIN, preferrably 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 \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+)', + ], + HttpReq => [ + '\bHttpRequest.* constructed, this=(\S+)', + '\bHttpRequest.* destructed, this=(\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 => [ + 'HttpStateData (\S+) created', + 'cbdataFree: Freeing (\S+)', + ], +); + +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 %Alive = (); +my $Count = 0; +while () { + if (/$reConstructor/) { + #die($_) if $Alive{$1}; + $Alive{$1} = $_; + ++$Count; + } + elsif (/$reDestructor/) { + #warn("unborn: $_") unless $Alive{$1}; + $Alive{$1} = undef(); + } +} + +printf(STDERR "Found %d %s\n", $Count, $Thing); + +my $AliveCount = 0; +foreach my $alive (sort grep { defined($_) } values %Alive) { + next unless defined $alive; + printf("Alive: %s", $alive); + ++$AliveCount; +} + +printf(STDERR "found %d still-alive %s\n", $AliveCount, $Thing); + +exit(0); diff --git a/scripts/trace-job.pl b/scripts/trace-job.pl new file mode 100755 index 0000000000..54f0657da7 --- /dev/null +++ b/scripts/trace-job.pl @@ -0,0 +1,48 @@ +#!/usr/bin/perl -w + +# Reads cache.log and displays lines that correspond to a given async job. +# +# If job entering/exiting line format changes, the script must be updated. +# Keep the old RE around for a while because they may be handy for working +# with folks running older Squids. + +use strict; +use warnings; + +my $XactId = shift or die("usage: $0 [log file]\n"); + +# Squid uses asyncNNN, jobNNN, icapxNNN for the same job/transaction +# TODO: use jobNNN everywhere +$XactId =~ s/^(?:async|job|icapx)(\d+)$/(async|job|icapx)$1/ and + warn("Replacing xaction ID with $XactId\n"); + +my $inside = 0; + +my $entering; + +while (<>) { + $entering = $_ if !$inside && /\| entering\b/; + undef $entering if /\| leaving\b/; + + # if (!$inside && /\bcalled\b.*\b$XactId\b/o) { + if (!$inside && /\bstatus in\b.*\b$XactId\b/o) { + print $entering if defined $entering; + $inside = 1; + } + + my $external = !$inside && /\b$XactId\b/o; + + print $_ if $inside || $external; + print "\n" if $external; + + next unless $inside; + + # if (/\bended\b.*\b$XactId\b/o || /\bswan\s+sang\b.*\b$XactId\b/o) { + # if (/\bstatus out\b.*\b$XactId\b/o || /\bswan\s+sang\b.*\b$XactId\b/o || + if (/\| leaving\b/) { + print "\n"; + $inside = 0; + } +} + +exit(0); diff --git a/scripts/trace-master.pl b/scripts/trace-master.pl new file mode 100755 index 0000000000..af54e6c6dd --- /dev/null +++ b/scripts/trace-master.pl @@ -0,0 +1,154 @@ +#!/usr/bin/perl -w + +# Reads cache.log and displays lines that correspond to the master transaction +# that has a given async job. Master transaction is all activities tied to a +# a single received HTTP request (client side, ACL, ICAP, server side, etc.). +# +# See trace-job.pl for tracing a single job instead of all jobs related to +# a master transaction. +# +# Currently, many master transaction activities are not tracked because they +# do not use AsyncJob API. Eventually, most activities should be identifiable. +# +# Currently, the script reads and remembers all master transactions because it +# does not know which one should be tracked in advance. Eventually, we may +# have a more efficient way of tying master transaction to a job. +# + + +use strict; +use warnings; + +my @InterestingJobs = @ARGV or die("usage: $0 ...\n"); + +my %Jobs = (); + +my $inside = 0; +my $entering; + +while () { + $entering = $_ if !$inside && /\| entering\b/; + undef $entering if /\| leaving\b/; + + if (!$inside && /\bstatus in\b.*\b(?:async|job|icapx)(\d+)\b/o) { + $inside = $1; + &enterJob($inside); + &updateJob($inside, $entering) if defined $entering; + undef $entering; + } + + next unless $inside; + + &updateJob($inside, $_); + + if (/AsyncJob constructed.*\[\S+?(\d+)\]/) { + &linkJobs($inside, $1, $_); + } + + if (/\| leaving\b/) { + $inside = 0; + } +} + +foreach my $id (@InterestingJobs) { + # Squid uses asyncNNN, jobNNN, icapxNNN for the same job/transaction + $id =~ s/^(?:async|job|icapx)(\d+)$/$1/; + reportJob($id, 1); +} + +exit(0); + + + +sub enterJob { + my ($id) = @_; + my $job = &getJob($id); +} + +sub updateJob { + my ($id, $line) = @_; + + my $job = &getJob($id); + $job->{history} .= $line; + + if ($line =~ /\bFD (\d+)/) { + $job->{fds}->{$1} = 1; + } +} + +sub linkJobs { + my ($parentId, $kidId, $line) = @_; + + my $parent = $Jobs{$parentId} or die("missing linked job $parentId"); + push @{$parent->{kids}}, $kidId; + + my $kid = &getJob($kidId); + die("two parents for $kidId: ". $kid->{parent}. " and $parentId") if $kid->{parent}; + $kid->{parent} = $parentId; + + $kid->{history} .= $line; # birth +} + +sub getJob { + my $id = shift; + + my $job = $Jobs{$id}; + return $job if $job; + + $job = { + id => $id, + kids => [], + fds => {}, + parent => undef(), + + start => undef(), + history => '', + }; + + $Jobs{$id} = $job; + return $job; +} + + +sub reportJob { + my ($id, $recursive) = @_; + + my $job = $Jobs{$id} or die("Did not see job$id\n"); + + &reportJob($job->{parent}, 0) if $job->{parent}; + + &reportJobParam($id, 'parent'); + &reportJobParam($id, 'kids', join(', ', @{$job->{kids}})); + &reportJobParam($id, 'FDs', join(', ', keys %{$job->{fds}})); + &reportJobHistory($id); + + return unless $recursive; + + foreach my $kidId (@{$job->{kids}}) { + &reportJob($kidId, $recursive); + } +} + +sub reportJobParam { + my ($id, $name, $value) = @_; + my $job = $Jobs{$id} or die; + + $value = $job->{$name} if @_ < 3; + $value = '?' unless defined $value; + $value = "\n$value" if $value =~ /\n/m; + printf("job%d %s: %s\n", $id, $name, $value); +} + +sub reportJobHistory { + my ($id) = @_; + my $job = $Jobs{$id} or die; + + my $history = $job->{history}; + my @lines = split(/\n/, $history); + &reportJobParam($id, 'history', (scalar @lines) . " entries"); + + foreach my $line (@lines) { + print "$line\n"; + print "\n" if $line =~ /\| leaving\b/; + } +}