]>
Commit | Line | Data |
---|---|---|
e83fd259 AR |
1 | #!/usr/bin/perl -w |
2 | ||
3 | # Reads cache.log and displays lines that correspond to the master transaction | |
4 | # that has a given async job. Master transaction is all activities tied to a | |
5 | # a single received HTTP request (client side, ACL, ICAP, server side, etc.). | |
6 | # | |
7 | # See trace-job.pl for tracing a single job instead of all jobs related to | |
8 | # a master transaction. | |
9 | # | |
10 | # Currently, many master transaction activities are not tracked because they | |
11 | # do not use AsyncJob API. Eventually, most activities should be identifiable. | |
12 | # | |
13 | # Currently, the script reads and remembers all master transactions because it | |
14 | # does not know which one should be tracked in advance. Eventually, we may | |
15 | # have a more efficient way of tying master transaction to a job. | |
16 | # | |
17 | ||
18 | ||
19 | use strict; | |
20 | use warnings; | |
21 | ||
22 | my @InterestingJobs = @ARGV or die("usage: $0 <job id> ...\n"); | |
23 | ||
24 | my %Jobs = (); | |
25 | ||
26 | my $inside = 0; | |
27 | my $entering; | |
28 | ||
29 | while (<STDIN>) { | |
30 | $entering = $_ if !$inside && /\| entering\b/; | |
31 | undef $entering if /\| leaving\b/; | |
32 | ||
33 | if (!$inside && /\bstatus in\b.*\b(?:async|job|icapx)(\d+)\b/o) { | |
34 | $inside = $1; | |
35 | &enterJob($inside); | |
36 | &updateJob($inside, $entering) if defined $entering; | |
37 | undef $entering; | |
38 | } | |
39 | ||
40 | next unless $inside; | |
41 | ||
42 | &updateJob($inside, $_); | |
43 | ||
44 | if (/AsyncJob constructed.*\[\S+?(\d+)\]/) { | |
45 | &linkJobs($inside, $1, $_); | |
46 | } | |
47 | ||
48 | if (/\| leaving\b/) { | |
49 | $inside = 0; | |
50 | } | |
51 | } | |
52 | ||
53 | foreach my $id (@InterestingJobs) { | |
54 | # Squid uses asyncNNN, jobNNN, icapxNNN for the same job/transaction | |
55 | $id =~ s/^(?:async|job|icapx)(\d+)$/$1/; | |
56 | reportJob($id, 1); | |
57 | } | |
58 | ||
59 | exit(0); | |
60 | ||
61 | ||
62 | ||
63 | sub enterJob { | |
64 | my ($id) = @_; | |
65 | my $job = &getJob($id); | |
66 | } | |
67 | ||
68 | sub updateJob { | |
69 | my ($id, $line) = @_; | |
70 | ||
71 | my $job = &getJob($id); | |
72 | $job->{history} .= $line; | |
73 | ||
74 | if ($line =~ /\bFD (\d+)/) { | |
75 | $job->{fds}->{$1} = 1; | |
76 | } | |
77 | } | |
78 | ||
79 | sub linkJobs { | |
80 | my ($parentId, $kidId, $line) = @_; | |
81 | ||
82 | my $parent = $Jobs{$parentId} or die("missing linked job $parentId"); | |
83 | push @{$parent->{kids}}, $kidId; | |
84 | ||
85 | my $kid = &getJob($kidId); | |
86 | die("two parents for $kidId: ". $kid->{parent}. " and $parentId") if $kid->{parent}; | |
87 | $kid->{parent} = $parentId; | |
88 | ||
89 | $kid->{history} .= $line; # birth | |
90 | } | |
91 | ||
92 | sub getJob { | |
93 | my $id = shift; | |
94 | ||
95 | my $job = $Jobs{$id}; | |
96 | return $job if $job; | |
97 | ||
98 | $job = { | |
99 | id => $id, | |
100 | kids => [], | |
101 | fds => {}, | |
102 | parent => undef(), | |
103 | ||
104 | start => undef(), | |
105 | history => '', | |
106 | }; | |
107 | ||
108 | $Jobs{$id} = $job; | |
109 | return $job; | |
110 | } | |
111 | ||
112 | ||
113 | sub reportJob { | |
114 | my ($id, $recursive) = @_; | |
115 | ||
116 | my $job = $Jobs{$id} or die("Did not see job$id\n"); | |
117 | ||
118 | &reportJob($job->{parent}, 0) if $job->{parent}; | |
119 | ||
120 | &reportJobParam($id, 'parent'); | |
121 | &reportJobParam($id, 'kids', join(', ', @{$job->{kids}})); | |
122 | &reportJobParam($id, 'FDs', join(', ', keys %{$job->{fds}})); | |
123 | &reportJobHistory($id); | |
124 | ||
125 | return unless $recursive; | |
126 | ||
127 | foreach my $kidId (@{$job->{kids}}) { | |
128 | &reportJob($kidId, $recursive); | |
129 | } | |
130 | } | |
131 | ||
132 | sub reportJobParam { | |
133 | my ($id, $name, $value) = @_; | |
134 | my $job = $Jobs{$id} or die; | |
135 | ||
136 | $value = $job->{$name} if @_ < 3; | |
137 | $value = '?' unless defined $value; | |
138 | $value = "\n$value" if $value =~ /\n/m; | |
139 | printf("job%d %s: %s\n", $id, $name, $value); | |
140 | } | |
141 | ||
142 | sub reportJobHistory { | |
143 | my ($id) = @_; | |
144 | my $job = $Jobs{$id} or die; | |
145 | ||
146 | my $history = $job->{history}; | |
147 | my @lines = split(/\n/, $history); | |
148 | &reportJobParam($id, 'history', (scalar @lines) . " entries"); | |
149 | ||
150 | foreach my $line (@lines) { | |
151 | print "$line\n"; | |
152 | print "\n" if $line =~ /\| leaving\b/; | |
153 | } | |
154 | } |