From: Alex Rousskov <rousskov@measurement-factory.com>
Date: Tue, 9 Jul 2013 23:01:38 +0000 (-0600)
Subject: Added a script to extract store entry(ies) debugging from cache.log.
X-Git-Tag: SQUID_3_5_0_1~444^2~34
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=e5433948164cec8919bb0337bf92ab4a0f94bc73;p=thirdparty%2Fsquid.git

Added a script to extract store entry(ies) debugging from cache.log.
---

diff --git a/scripts/trace-entry.pl b/scripts/trace-entry.pl
new file mode 100755
index 0000000000..318a04160c
--- /dev/null
+++ b/scripts/trace-entry.pl
@@ -0,0 +1,273 @@
+#!/usr/bin/perl -w
+
+# Reads cache.log and displays lines that correspond to a given store entry.
+#
+# Store entry can be identified by its key or an anchor slot ID in a rock-style
+# map.
+#
+# Currently, the script reads and remembers many irrelevant lines because it
+# does not know which one should be tracked in advance.
+# 
+
+use strict;
+use warnings;
+use Carp;
+
+my @InterestingEntries = @ARGV;
+#die("usage: $0 [entry number|key value|pointer address] ...\n");
+
+my $LastEntryId = 0;
+my %Entries = ();
+my %EntriesByPartId = ();
+
+my %CurrentEntries = ();
+my $Kid;
+my %Entering = ();
+my %Inside = ();
+
+my $DEB;
+
+while (<STDIN>) {
+	my $line = $_;
+	#$DEB = 1 if /16:53:44.632/;
+
+	($Kid) = (/(kid\d+)[|]/);
+	$Kid = 'kid0' unless defined $Kid;
+
+	&enterBlock($., $_) if
+		(/[|:] entering\b/ && !/Port::noteRead/) ||
+        (/Port::noteRead/ && /handling/);
+
+	next unless $Inside{$Kid};
+
+	while ($line =~ s@\b(entry) (\d+) .*?(\S*_map)@ @) {
+		&processEntryPartId("$3.$1", $2);
+	}
+
+	while ($line =~ s@\b(slice|slot) (\d+)@ @) {
+		&processEntryPartId($1, $2);
+	}
+
+	#while ($line =~ s@\b(page) (\w+)@ @) {
+	#	&processEntryPartId($1, $2);
+	#}
+
+	while ($line =~ s@\b(key) '?(\w+)@ @) {
+		&processEntryPartId($1, $2);
+	}
+
+	while ($line =~ s@\b([A-Z0-9]{32})\b@ @) {
+		&processEntryPartId('key', $1);
+	}
+
+	while ($line =~ s@\be:\S*?/(0x\w+)@ @ || $line =~ s@\bStoreEntry\s+(0x\w+)@ @) {
+		&processEntryPartId('pointer', $1);
+	}
+
+	if ($line ne $_ || /[|:] leaving\b/) {
+		if (my $entry = $CurrentEntries{$Kid}) {
+			&updateEntry($entry, $Entering{$Kid}) if exists $Entering{$Kid};
+			delete $Entering{$Kid};
+			&updateEntry($entry, &historyLine($., $_));
+		}
+	}
+
+	&leaveBlock() if
+       (/[|:] leaving\b/ && !/Port::noteRead/) ||
+        (/Port::noteRead/ && /handled/);
+}
+
+
+# merge same entries
+my %cleanEntries = ();
+foreach my $id (sort { $a <=> $b } keys %Entries) {
+	my $entry = $Entries{$id};
+
+	next unless &mergeAllLinkedEntries($entry);
+
+	$entry->{id} = 1 + scalar keys %cleanEntries;
+	$cleanEntries{$entry->{id}} = $entry;
+}
+%Entries = %cleanEntries;
+
+printf("Saw %d entries\n", scalar keys %Entries);
+
+if (!@InterestingEntries) { # print all entries
+	foreach my $id (sort { $a <=> $b } keys %Entries) {
+		my $entry = $Entries{$id};
+		reportEntry($entry, 1);
+	}
+} else {
+	foreach my $description (@InterestingEntries) {
+		my ($part, $id) = ($description =~ /(\w+)\s+(\w+)/);
+		my $entry = &getExistingEntry($part, $id);
+		reportEntry($entry, 1);
+	}
+}
+
+exit(0);
+
+sub enterBlock {
+	my ($lineNo, $lineText) = @_;
+
+	$Entering{$Kid} = &historyLine($., $_);
+	die("double entrance, stopped") if $Inside{$Kid};
+	$Inside{$Kid} = 1;
+}
+
+sub leaveBlock {
+	$CurrentEntries{$Kid} = undef();
+	delete $Entering{$Kid};
+	$Inside{$Kid} = 0;
+}
+
+sub processEntryPartId {
+	my ($part, $id) = @_;
+
+	#warn("XXX1: $Kid| part.id: $part.$id\n") if $DEB;
+
+	my $entry;
+	my $curEntry = $CurrentEntries{$Kid};
+	my $oldEntry = &getExistingEntry($part, $id);
+	if ($curEntry && $oldEntry && $curEntry->{id} != $oldEntry->{id}) {
+		&linkEntries($curEntry, $oldEntry, "$part.$id");
+		$entry = $curEntry;
+	} else {
+		$entry = $curEntry ? $curEntry : $oldEntry;
+	}
+	$entry = &getEntry($part, $id) unless defined $entry;
+	$CurrentEntries{$Kid} = $entry;
+
+	$entry->{parts}->{$part} = {} unless exists $entry->{parts}->{$part};
+	$entry->{parts}->{$part}->{$id} = $_ unless exists $entry->{parts}->{$part}->{$id};
+}
+
+sub historyLine {
+	my ($lineCount, $line) = @_;
+	return sprintf("#%06d %s", $lineCount, $line);
+}
+
+sub updateEntry {
+	my ($entry, $historyLine) = @_;
+
+	$entry->{history} .= $historyLine;
+}
+
+sub linkEntries {
+	my ($e1, $e2, $ctx) = @_;
+
+	$e1->{sameAs}->{$e2->{id}} = 1;
+	$e2->{sameAs}->{$e1->{id}} = 1;
+}
+
+sub mergeAllLinkedEntries {
+	my ($entry) = @_;
+
+	#warn(sprintf("merging %d <-- * %s\n", $entry->{id}, $entry->{merged} ? "skipped" : ""));
+
+	return 0 if $entry->{merged};
+	$entry->{merged} = 1;
+
+	foreach my $otherId (keys %{$entry->{sameAs}}) {
+		my $otherE = $Entries{$otherId};
+		die("missing internal entry$otherId, stopped") unless $otherE;
+		next if $otherE->{merged};
+		&mergeAllLinkedEntries($otherE);
+		&mergeOneEntry($entry, $otherE);
+		$otherE->{merged} = 1;
+	}
+
+	return 1;
+}
+
+sub mergeOneEntry {
+	my ($entry, $otherE) = @_;
+
+	#warn(sprintf("merging %d <-- %d\n", $entry->{id}, $otherE->{id}));
+
+	foreach my $part (keys %{$otherE->{parts}}) {
+        foreach my $id (keys %{$otherE->{parts}->{$part}}) {
+            $entry->{parts}->{$part}->{$id} = $otherE->{parts}->{$part}->{$id};
+		}
+	}
+
+	$entry->{history} .= $otherE->{history};
+}
+
+sub getExistingEntry {
+	my ($part, $id) = @_;
+
+	return $EntriesByPartId{$part}->{$id} if exists $EntriesByPartId{$part};
+	return undef();
+}
+
+sub getEntry {
+	my ($part, $id) = @_;
+
+	$EntriesByPartId{$part} = {} unless exists $EntriesByPartId{$part};
+	my $entry = $EntriesByPartId{$part}->{$id};
+	return $entry if $entry;
+
+	$entry = {
+		id => ++$LastEntryId,
+
+		parts => {},
+
+		history => '',
+
+		reported => 0,
+	};
+
+	$entry->{parts}->{$part} = {};
+	$EntriesByPartId{$part}->{$id} = $entry;
+	$Entries{$LastEntryId} = $entry;
+	return $entry;
+}
+
+
+sub reportEntry {
+	my ($entry, $recursive) = @_;
+
+	return if $entry->{reported};
+	$entry->{reported} = 1;
+
+	printf("entry%d:\n", $entry->{id});
+
+	foreach my $part (keys %{$entry->{parts}}) {
+		printf("\t%s(s):", $part);
+		foreach my $id (keys %{$entry->{parts}->{$part}}) {
+			printf(" %s", $id);
+		}
+		print("\n");
+	}
+
+	&reportEntryHistory($entry);
+}
+
+sub reportEntryParam {
+	my ($entry, $name, $value) = @_;
+
+	$value = $entry->{$name} if @_ < 3;
+	$value = '?' unless defined $value;
+	$value = "\n$value" if $value =~ /\n/m;
+	printf("\t%s: %s\n", $name, $value);
+}
+
+sub reportEntryHistory {
+	my ($entry) = @_;
+
+	my $history = $entry->{history};
+	my @lines = split(/\n/, $history);
+	&reportEntryParam($entry, 'history', (scalar @lines) . " lines");
+
+	my $lastKid = '';
+	foreach my $line (sort @lines) {
+		my ($kid) = ($line =~ /(kid\d+)[|]/);
+		$kid = 'kid0' unless defined $kid;
+
+		print "\n" if $lastKid ne $kid;
+		print "$line\n";
+		$lastKid = $kid;
+	}
+	print "\n" if @lines;
+}