1#!/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>.
13
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$
37
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' || $call eq 'clone' || $call eq 'vfork') {
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