blob: 1746b920e812daee4313ece2aabf595739662704 [file] [log] [blame]
Wichert Akkerman9ce1a631999-08-29 23:15:07 +00001#!/usr/bin/perl
2
3# This script processes strace -f output. It displays a graph of invoked
4# subprocesses, and is useful for finding out what complex commands do.
5
6# You will probably want to invoke strace with -q as well, and with
7# -s 100 to get complete filenames.
8
9# The script can also handle the output with strace -t, -tt, or -ttt.
10# It will add elapsed time for each process in that case.
11
12# This script is Copyright (C) 1998 by Richard Braakman <dark@xs4all.nl>.
Wichert Akkerman7b27ba01999-08-30 23:26:53 +000013
14# Redistribution and use in source and binary forms, with or without
15# modification, are permitted provided that the following conditions
16# are met:
17# 1. Redistributions of source code must retain the above copyright
18# notice, this list of conditions and the following disclaimer.
19# 2. Redistributions in binary form must reproduce the above copyright
20# notice, this list of conditions and the following disclaimer in the
21# documentation and/or other materials provided with the distribution.
22# 3. The name of the author may not be used to endorse or promote products
23# derived from this software without specific prior written permission.
24#
25# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
26# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
27# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
28# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
29# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
30# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
31# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
32# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
33# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
34# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35#
36# $Id$
Wichert Akkerman9ce1a631999-08-29 23:15:07 +000037
38my %unfinished;
39
40# Scales for strace slowdown. Make configurable!
41my $scale_factor = 3.5;
42
43while (<>) {
44 my ($pid, $call, $args, $result, $time);
45 chop;
46
47 s/^(\d+)\s+//;
48 $pid = $1;
49
50 if (s/^(\d\d):(\d\d):(\d\d)(?:\.(\d\d\d\d\d\d))? //) {
51 $time = $1 * 3600 + $2 * 60 + $3;
52 if (defined $4) {
53 $time = $time + $4 / 1000000;
54 $floatform = 1;
55 }
56 } elsif (s/^(\d+)\.(\d\d\d\d\d\d) //) {
57 $time = $1 + ($2 / 1000000);
58 $floatform = 1;
59 }
60
61 if (s/ <unfinished ...>$//) {
62 $unfinished{$pid} = $_;
63 next;
64 }
65
66 if (s/^<... \S+ resumed> //) {
67 unless (exists $unfinished{$pid}) {
68 print STDERR "$0: $ARGV: cannot find start of resumed call on line $.";
69 next;
70 }
71 $_ = $unfinished{$pid} . $_;
72 delete $unfinished{$pid};
73 }
74
75 if (/^--- SIG(\S+) \(.*\) ---$/) {
76 # $pid received signal $1
77 # currently we don't do anything with this
78 next;
79 }
80
81 if (/^\+\+\+ killed by SIG(\S+) \+\+\+$/) {
82 # $pid received signal $1
83 handle_killed($pid, $time);
84 next;
85 }
86
87 ($call, $args, $result) = /(\S+)\((.*)\)\s+= (.*)$/;
88 unless (defined $result) {
89 print STDERR "$0: $ARGV: $.: cannot parse line.\n";
90 next;
91 }
92
93 handle_trace($pid, $call, $args, $result, $time);
94}
95
96display_trace();
97
98exit 0;
99
100sub parse_str {
101 my ($in) = @_;
102 my $result = "";
103
104 while (1) {
105 if ($in =~ s/^\\(.)//) {
106 $result .= $1;
107 } elsif ($in =~ s/^\"//) {
108 if ($in =~ s/^\.\.\.//) {
109 return ("$result...", $in);
110 }
111 return ($result, $in);
112 } elsif ($in =~ s/([^\\\"]*)//) {
113 $result .= $1;
114 } else {
115 return (undef, $in);
116 }
117 }
118}
119
120sub parse_one {
121 my ($in) = @_;
122
123 if ($in =~ s/^\"//) {
124 ($tmp, $in) = parse_str($in);
125 if (not defined $tmp) {
126 print STDERR "$0: $ARGV: $.: cannot parse string.\n";
127 return (undef, $in);
128 }
129 return ($tmp, $in);
130 } elsif ($in =~ s/^0x(\x+)//) {
131 return (hex $1, $in);
132 } elsif ($in =~ s/^(\d+)//) {
133 return (int $1, $in);
134 } else {
135 print STDERR "$0: $ARGV: $.: unrecognized element.\n";
136 return (undef, $in);
137 }
138}
139
140sub parseargs {
141 my ($in) = @_;
142 my @args = ();
143 my $tmp;
144
145 while (length $in) {
146 if ($in =~ s/^\[//) {
147 my @subarr = ();
148 if ($in =~ s,^/\* (\d+) vars \*/\],,) {
149 push @args, $1;
150 } else {
151 while ($in !~ s/^\]//) {
152 ($tmp, $in) = parse_one($in);
153 defined $tmp or return undef;
154 push @subarr, $tmp;
155 unless ($in =~ /^\]/ or $in =~ s/^, //) {
156 print STDERR "$0: $ARGV: $.: missing comma in array.\n";
157 return undef;
158 }
159 if ($in =~ s/^\.\.\.//) {
160 push @subarr, "...";
161 }
162 }
163 push @args, \@subarr;
164 }
165 } elsif ($in =~ s/^\{//) {
166 my %subhash = ();
167 while ($in !~ s/^\}//) {
168 my $key;
169 unless ($in =~ s/^(\w+)=//) {
170 print STDERR "$0: $ARGV: $.: struct field expected.\n";
171 return undef;
172 }
173 $key = $1;
174 ($tmp, $in) = parse_one($in);
175 defined $tmp or return undef;
176 $subhash{$key} = $tmp;
177 unless ($in =~ s/, //) {
178 print STDERR "$0: $ARGV: $.: missing comma in struct.\n";
179 return undef;
180 }
181 }
182 push @args, \%subhash;
183 } else {
184 ($tmp, $in) = parse_one($in);
185 defined $tmp or return undef;
186 push @args, $tmp;
187 }
188 unless (length($in) == 0 or $in =~ s/^, //) {
189 print STDERR "$0: $ARGV: $.: missing comma.\n";
190 return undef;
191 }
192 }
193 return @args;
194}
195
196
197my $depth = "";
198
199# process info, indexed by pid.
200# fields:
201# parent pid number
202# seq forks and execs for this pid, in sequence (array)
203
204# filename and argv (from latest exec)
205# basename (derived from filename)
206# argv[0] is modified to add the basename if it differs from the 0th argument.
207
208my %pr;
209
210sub handle_trace {
211 my ($pid, $call, $args, $result, $time) = @_;
212 my $p;
213
214 if (defined $time and not defined $pr{$pid}{start}) {
215 $pr{$pid}{start} = $time;
216 }
217
218 if ($call eq 'execve') {
219 return if $result != 0;
220
221 my ($filename, $argv) = parseargs($args);
222 ($basename) = $filename =~ m/([^\/]*)$/;
223 if ($basename ne $$argv[0]) {
224 $$argv[0] = "$basename($$argv[0])";
225 }
226 my $seq = $pr{$pid}{seq};
227 $seq = [] if not defined $seq;
228
229 push @$seq, ['EXEC', $filename, $argv];
230
231 $pr{$pid}{seq} = $seq;
232 } elsif ($call eq 'fork') {
233 return if $result == 0;
234
235 my $seq = $pr{$pid}{seq};
236 $seq = [] if not defined $seq;
237 push @$seq, ['FORK', $result];
238 $pr{$pid}{seq} = $seq;
239 $pr{$result}{parent} = $pid;
240 } elsif ($call eq '_exit') {
241 $pr{$pid}{end} = $time if defined $time;
242 }
243}
244
245sub handle_killed {
246 my ($pid, $time) = @_;
247 $pr{$pid}{end} = $time if defined $time;
248}
249
250sub straight_seq {
251 my ($pid) = @_;
252 my $seq = $pr{$pid}{seq};
253
254 for $elem (@$seq) {
255 if ($$elem[0] eq 'EXEC') {
256 my $argv = $$elem[2];
257 print "$$elem[0] $$elem[1] @$argv\n";
258 } elsif ($$elem[0] eq 'FORK') {
259 print "$$elem[0] $$elem[1]\n";
260 } else {
261 print "$$elem[0]\n";
262 }
263 }
264}
265
266sub first_exec {
267 my ($pid) = @_;
268 my $seq = $pr{$pid}{seq};
269
270 for $elem (@$seq) {
271 if ($$elem[0] eq 'EXEC') {
272 return $elem;
273 }
274 }
275 return undef;
276}
277
278sub display_pid_trace {
279 my ($pid, $lead) = @_;
280 my $i = 0;
281 my @seq = @{$pr{$pid}{seq}};
282 my $elapsed;
283
284 if (not defined first_exec($pid)) {
285 unshift @seq, ['EXEC', '', ['(anon)'] ];
286 }
287
288 if (defined $pr{$pid}{start} and defined $pr{$pid}{end}) {
289 $elapsed = $pr{$pid}{end} - $pr{$pid}{start};
290 $elapsed /= $scale_factor;
291 if ($floatform) {
292 $elapsed = sprintf("%0.02f", $elapsed);
293 } else {
294 $elapsed = int $elapsed;
295 }
296 }
297
298 for $elem (@seq) {
299 $i++;
300 if ($$elem[0] eq 'EXEC') {
301 my $argv = $$elem[2];
302 if (defined $elapsed) {
303 print "$lead [$elapsed] @$argv\n";
304 undef $elapsed;
305 } else {
306 print "$lead @$argv\n";
307 }
308 } elsif ($$elem[0] eq 'FORK') {
309 if ($i == 1) {
310 if ($lead =~ /-$/) {
311 display_pid_trace($$elem[1], "$lead--+--");
312 } else {
313 display_pid_trace($$elem[1], "$lead +--");
314 }
315 } elsif ($i == @seq) {
316 display_pid_trace($$elem[1], "$lead `--");
317 } else {
318 display_pid_trace($$elem[1], "$lead +--");
319 }
320 }
321 if ($i == 1) {
322 $lead =~ s/\`--/ /g;
323 $lead =~ s/-/ /g;
324 $lead =~ s/\+/|/g;
325 }
326 }
327}
328
329sub display_trace {
330 my ($startpid) = @_;
331
332 $startpid = (keys %pr)[0];
333 while ($pr{$startpid}{parent}) {
334 $startpid = $pr{$startpid}{parent};
335 }
336
337 display_pid_trace($startpid, "");
338}
339