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
--- /dev/null
+#!/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 <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+)',
+ ],
+ 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 (<STDIN>) {
+ 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);
--- /dev/null
+#!/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 <xaction id> [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);
--- /dev/null
+#!/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 <job id> ...\n");
+
+my %Jobs = ();
+
+my $inside = 0;
+my $entering;
+
+while (<STDIN>) {
+ $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/;
+ }
+}
projects / thirdparty / squid.git / commitdiff
