]>
git.ipfire.org Git - thirdparty/squid.git/blob - scripts/trace-entry.pl
3 ## Copyright (C) 1996-2017 The Squid Software Foundation and contributors
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.
10 # Reads cache.log and displays lines that correspond to a given store entry.
12 # Store entry can be identified by its key or an anchor slot ID in a rock-style
15 # Currently, the script reads and remembers many irrelevant lines because it
16 # does not know which one should be tracked in advance.
23 my @InterestingEntries = @ARGV;
24 #die("usage: $0 [entry number|key value|pointer address] ...\n");
28 my %EntriesByPartId = ();
30 my %CurrentEntries = ();
39 #$DEB = 1 if /16:53:44.632/;
41 ($Kid) = (/(kid\d+)[|]/);
42 $Kid = 'kid0' unless defined $Kid;
44 &enterBlock
($., $_) if
45 (/[|:] entering\b/ && !/Port::noteRead/) ||
46 (/Port::noteRead/ && /handling/);
48 next unless $Inside{$Kid};
50 while ($line =~ s@
\b(entry
) (\d
+) .*?
(\S
*_map
)@ @
) {
51 &processEntryPartId
("$3.$1", $2);
54 while ($line =~ s@
\b(slice
|slot
) (\d
+)@ @
) {
55 &processEntryPartId
($1, $2);
58 #while ($line =~ s@\b(page) (\w+)@ @) {
59 # &processEntryPartId($1, $2);
62 while ($line =~ s@
\b(key
) '?(\w+)@ @) {
63 &processEntryPartId($1, $2);
66 while ($line =~ s@\b([A-Z0-9]{32})\b@ @) {
67 &processEntryPartId('key
', $1);
70 while ($line =~ s@\be:\S*?/(0x\w+)@ @ || $line =~ s@\bStoreEntry\s+(0x\w+)@ @) {
71 &processEntryPartId('pointer
', $1);
74 if ($line ne $_ || /[|:] leaving\b/) {
75 if (my $entry = $CurrentEntries{$Kid}) {
76 &updateEntry($entry, $Entering{$Kid}) if exists $Entering{$Kid};
77 delete $Entering{$Kid};
78 &updateEntry($entry, &historyLine($., $_));
83 (/[|:] leaving\b/ && !/Port::noteRead/) ||
84 (/Port::noteRead/ && /handled/);
89 my %cleanEntries = ();
90 foreach my $id (sort { $a <=> $b } keys %Entries) {
91 my $entry = $Entries{$id};
93 next unless &mergeAllLinkedEntries($entry);
95 $entry->{id} = 1 + scalar keys %cleanEntries;
96 $cleanEntries{$entry->{id}} = $entry;
98 %Entries = %cleanEntries;
100 printf("Saw %d entries\n", scalar keys %Entries);
102 if (!@InterestingEntries) { # print all entries
103 foreach my $id (sort { $a <=> $b } keys %Entries) {
104 my $entry = $Entries{$id};
105 reportEntry($entry, 1);
108 foreach my $description (@InterestingEntries) {
109 my ($part, $id) = ($description =~ /(\w+)\s+(\w+)/);
110 my $entry = &getExistingEntry($part, $id);
111 reportEntry($entry, 1);
118 my ($lineNo, $lineText) = @_;
120 $Entering{$Kid} = &historyLine($., $_);
121 die("double entrance, stopped") if $Inside{$Kid};
126 $CurrentEntries{$Kid} = undef();
127 delete $Entering{$Kid};
131 sub processEntryPartId {
132 my ($part, $id) = @_;
134 #warn("XXX1: $Kid| part.id: $part.$id\n") if $DEB;
137 my $curEntry = $CurrentEntries{$Kid};
138 my $oldEntry = &getExistingEntry($part, $id);
139 if ($curEntry && $oldEntry && $curEntry->{id} != $oldEntry->{id}) {
140 &linkEntries($curEntry, $oldEntry, "$part.$id");
143 $entry = $curEntry ? $curEntry : $oldEntry;
145 $entry = &getEntry($part, $id) unless defined $entry;
146 $CurrentEntries{$Kid} = $entry;
148 $entry->{parts}->{$part} = {} unless exists $entry->{parts}->{$part};
149 $entry->{parts}->{$part}->{$id} = $_ unless exists $entry->{parts}->{$part}->{$id};
153 my ($lineCount, $line) = @_;
154 return sprintf("#%06d %s", $lineCount, $line);
158 my ($entry, $historyLine) = @_;
160 $entry->{history} .= $historyLine;
164 my ($e1, $e2, $ctx) = @_;
166 $e1->{sameAs}->{$e2->{id}} = 1;
167 $e2->{sameAs}->{$e1->{id}} = 1;
170 sub mergeAllLinkedEntries {
173 #warn(sprintf("merging %d <-- * %s\n", $entry->{id}, $entry->{merged} ? "skipped" : ""));
175 return 0 if $entry->{merged};
176 $entry->{merged} = 1;
178 foreach my $otherId (keys %{$entry->{sameAs}}) {
179 my $otherE = $Entries{$otherId};
180 die("missing internal entry$otherId, stopped") unless $otherE;
181 next if $otherE->{merged};
182 &mergeAllLinkedEntries($otherE);
183 &mergeOneEntry($entry, $otherE);
184 $otherE->{merged} = 1;
191 my ($entry, $otherE) = @_;
193 #warn(sprintf("merging %d <-- %d\n", $entry->{id}, $otherE->{id}));
195 foreach my $part (keys %{$otherE->{parts}}) {
196 foreach my $id (keys %{$otherE->{parts}->{$part}}) {
197 $entry->{parts}->{$part}->{$id} = $otherE->{parts}->{$part}->{$id};
201 $entry->{history} .= $otherE->{history};
204 sub getExistingEntry {
205 my ($part, $id) = @_;
207 return $EntriesByPartId{$part}->{$id} if exists $EntriesByPartId{$part};
212 my ($part, $id) = @_;
214 $EntriesByPartId{$part} = {} unless exists $EntriesByPartId{$part};
215 my $entry = $EntriesByPartId{$part}->{$id};
216 return $entry if $entry;
219 id => ++$LastEntryId,
228 $entry->{parts}->{$part} = {};
229 $EntriesByPartId{$part}->{$id} = $entry;
230 $Entries{$LastEntryId} = $entry;
236 my ($entry, $recursive) = @_;
238 return if $entry->{reported};
239 $entry->{reported} = 1;
241 printf("entry%d:\n", $entry->{id});
243 foreach my $part (keys %{$entry->{parts}}) {
244 printf("\t%s(s):", $part);
245 foreach my $id (keys %{$entry->{parts}->{$part}}) {
251 &reportEntryHistory($entry);
254 sub reportEntryParam {
255 my ($entry, $name, $value) = @_;
257 $value = $entry->{$name} if @_ < 3;
258 $value = '?
' unless defined $value;
259 $value = "\n$value" if $value =~ /\n/m;
260 printf("\t%s: %s\n", $name, $value);
263 sub reportEntryHistory {
266 my $history = $entry->{history};
267 my @lines = split(/\n/, $history);
268 &reportEntryParam($entry, 'history
', (scalar @lines) . " lines");
271 foreach my $line (sort @lines) {
272 my ($kid) = ($line =~ /(kid\d+)[|]/);
273 $kid = 'kid0
' unless defined $kid;
275 print "\n" if $lastKid ne $kid;
279 print "\n" if @lines;