• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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
36my %unfinished;
37
38# Scales for strace slowdown.  Make configurable!
39my $scale_factor = 3.5;
40
41while (<>) {
42    my ($pid, $call, $args, $result, $time);
43    chop;
44
45    s/^(\d+)\s+//;
46    $pid = $1;
47
48    if (s/^(\d\d):(\d\d):(\d\d)(?:\.(\d\d\d\d\d\d))? //) {
49	$time = $1 * 3600 + $2 * 60 + $3;
50	if (defined $4) {
51	    $time = $time + $4 / 1000000;
52	    $floatform = 1;
53	}
54    } elsif (s/^(\d+)\.(\d\d\d\d\d\d) //) {
55	$time = $1 + ($2 / 1000000);
56	$floatform = 1;
57    }
58
59    if (s/ <unfinished ...>$//) {
60	$unfinished{$pid} = $_;
61	next;
62    }
63
64    if (s/^<... \S+ resumed> //) {
65	unless (exists $unfinished{$pid}) {
66	    print STDERR "$0: $ARGV: cannot find start of resumed call on line $.";
67	    next;
68	}
69	$_ = $unfinished{$pid} . $_;
70	delete $unfinished{$pid};
71    }
72
73    if (/^--- SIG(\S+) \(.*\) ---$/) {
74	# $pid received signal $1
75	# currently we don't do anything with this
76	next;
77    }
78
79    if (/^\+\+\+ killed by SIG(\S+) \+\+\+$/) {
80	# $pid received signal $1
81	handle_killed($pid, $time);
82	next;
83    }
84
85    ($call, $args, $result) = /(\S+)\((.*)\)\s+= (.*)$/;
86    unless (defined $result) {
87	print STDERR "$0: $ARGV: $.: cannot parse line.\n";
88	next;
89    }
90
91    handle_trace($pid, $call, $args, $result, $time);
92}
93
94display_trace();
95
96exit 0;
97
98sub parse_str {
99    my ($in) = @_;
100    my $result = "";
101
102    while (1) {
103	if ($in =~ s/^\\(.)//) {
104	    $result .= $1;
105	} elsif ($in =~ s/^\"//) {
106	    if ($in =~ s/^\.\.\.//) {
107		return ("$result...", $in);
108	    }
109	    return ($result, $in);
110	} elsif ($in =~ s/([^\\\"]*)//) {
111	    $result .= $1;
112	} else {
113	    return (undef, $in);
114	}
115    }
116}
117
118sub parse_one {
119    my ($in) = @_;
120
121    if ($in =~ s/^\"//) {
122	($tmp, $in) = parse_str($in);
123	if (not defined $tmp) {
124	    print STDERR "$0: $ARGV: $.: cannot parse string.\n";
125	    return (undef, $in);
126	}
127	return ($tmp, $in);
128    } elsif ($in =~ s/^0x(\x+)//) {
129	return (hex $1, $in);
130    } elsif ($in =~ s/^(\d+)//) {
131	return (int $1, $in);
132    } else {
133	print STDERR "$0: $ARGV: $.: unrecognized element.\n";
134	return (undef, $in);
135    }
136}
137
138sub parseargs {
139    my ($in) = @_;
140    my @args = ();
141    my $tmp;
142
143    while (length $in) {
144	if ($in =~ s/^\[//) {
145	    my @subarr = ();
146	    if ($in =~ s,^/\* (\d+) vars \*/\],,) {
147		push @args, $1;
148	    } else {
149		while ($in !~ s/^\]//) {
150		    ($tmp, $in) = parse_one($in);
151		    defined $tmp or return undef;
152		    push @subarr, $tmp;
153		    unless ($in =~ /^\]/ or $in =~ s/^, //) {
154			print STDERR "$0: $ARGV: $.: missing comma in array.\n";
155			return undef;
156		    }
157		    if ($in =~ s/^\.\.\.//) {
158			push @subarr, "...";
159		    }
160		}
161		push @args, \@subarr;
162	    }
163	} elsif ($in =~ s/^\{//) {
164	    my %subhash = ();
165	    while ($in !~ s/^\}//) {
166		my $key;
167		unless ($in =~ s/^(\w+)=//) {
168		    print STDERR "$0: $ARGV: $.: struct field expected.\n";
169		    return undef;
170		}
171		$key = $1;
172		($tmp, $in) = parse_one($in);
173		defined $tmp or return undef;
174		$subhash{$key} = $tmp;
175		unless ($in =~ s/, //) {
176		    print STDERR "$0: $ARGV: $.: missing comma in struct.\n";
177		    return undef;
178		}
179	    }
180	    push @args, \%subhash;
181	} else {
182	    ($tmp, $in) = parse_one($in);
183	    defined $tmp or return undef;
184	    push @args, $tmp;
185	}
186	unless (length($in) == 0 or $in =~ s/^, //) {
187	    print STDERR "$0: $ARGV: $.: missing comma.\n";
188	    return undef;
189	}
190    }
191    return @args;
192}
193
194
195my $depth = "";
196
197# process info, indexed by pid.
198# fields:
199#    parent         pid number
200#    seq            forks and execs for this pid, in sequence  (array)
201
202#  filename and argv (from latest exec)
203#  basename (derived from filename)
204# argv[0] is modified to add the basename if it differs from the 0th argument.
205
206my %pr;
207
208sub handle_trace {
209    my ($pid, $call, $args, $result, $time) = @_;
210    my $p;
211
212    if (defined $time and not defined $pr{$pid}{start}) {
213	$pr{$pid}{start} = $time;
214    }
215
216    if ($call eq 'execve') {
217	return if $result != 0;
218
219	my ($filename, $argv) = parseargs($args);
220	($basename) = $filename =~ m/([^\/]*)$/;
221	if ($basename ne $$argv[0]) {
222	    $$argv[0] = "$basename($$argv[0])";
223        }
224	my $seq = $pr{$pid}{seq};
225	$seq = [] if not defined $seq;
226
227	push @$seq, ['EXEC', $filename, $argv];
228
229	$pr{$pid}{seq} = $seq;
230    } elsif ($call eq 'fork' || $call eq 'clone' || $call eq 'vfork') {
231	return if $result == 0;
232
233	my $seq = $pr{$pid}{seq};
234	$seq = [] if not defined $seq;
235	push @$seq, ['FORK', $result];
236	$pr{$pid}{seq} = $seq;
237	$pr{$result}{parent} = $pid;
238    } elsif ($call eq '_exit') {
239	$pr{$pid}{end} = $time if defined $time;
240    }
241}
242
243sub handle_killed {
244    my ($pid, $time) = @_;
245    $pr{$pid}{end} = $time if defined $time;
246}
247
248sub straight_seq {
249    my ($pid) = @_;
250    my $seq = $pr{$pid}{seq};
251
252    for $elem (@$seq) {
253	if ($$elem[0] eq 'EXEC') {
254	    my $argv = $$elem[2];
255	    print "$$elem[0] $$elem[1] @$argv\n";
256	} elsif ($$elem[0] eq 'FORK') {
257	    print "$$elem[0] $$elem[1]\n";
258	} else {
259	    print "$$elem[0]\n";
260	}
261    }
262}
263
264sub first_exec {
265    my ($pid) = @_;
266    my $seq = $pr{$pid}{seq};
267
268    for $elem (@$seq) {
269	if ($$elem[0] eq 'EXEC') {
270	    return $elem;
271	}
272    }
273    return undef;
274}
275
276sub display_pid_trace {
277    my ($pid, $lead) = @_;
278    my $i = 0;
279    my @seq = @{$pr{$pid}{seq}};
280    my $elapsed;
281
282    if (not defined first_exec($pid)) {
283	unshift @seq, ['EXEC', '', ['(anon)'] ];
284    }
285
286    if (defined $pr{$pid}{start} and defined $pr{$pid}{end}) {
287	$elapsed = $pr{$pid}{end} - $pr{$pid}{start};
288	$elapsed /= $scale_factor;
289	if ($floatform) {
290	    $elapsed = sprintf("%0.02f", $elapsed);
291	} else {
292	    $elapsed = int $elapsed;
293	}
294    }
295
296    for $elem (@seq) {
297	$i++;
298	if ($$elem[0] eq 'EXEC') {
299	    my $argv = $$elem[2];
300	    if (defined $elapsed) {
301		print "$lead [$elapsed] @$argv\n";
302		undef $elapsed;
303	    } else {
304		print "$lead @$argv\n";
305	    }
306	} elsif ($$elem[0] eq 'FORK') {
307	    if ($i == 1) {
308                if ($lead =~ /-$/) {
309		    display_pid_trace($$elem[1], "$lead--+--");
310                } else {
311		    display_pid_trace($$elem[1], "$lead  +--");
312                }
313	    } elsif ($i == @seq) {
314		display_pid_trace($$elem[1], "$lead  `--");
315	    } else {
316		display_pid_trace($$elem[1], "$lead  +--");
317	    }
318	}
319	if ($i == 1) {
320	    $lead =~ s/\`--/   /g;
321	    $lead =~ s/-/ /g;
322	    $lead =~ s/\+/|/g;
323	}
324    }
325}
326
327sub display_trace {
328    my ($startpid) = @_;
329
330    $startpid = (keys %pr)[0];
331    while ($pr{$startpid}{parent}) {
332	$startpid = $pr{$startpid}{parent};
333    }
334
335    display_pid_trace($startpid, "");
336}
337