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.
6 # You will probably want to invoke strace with -q as well, and with
7 # -s 100 to get complete filenames.
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.
12 # Copyright (c) 1998 by Richard Braakman <dark@xs4all.nl>.
13 # Copyright (c) 1998-2017 The strace developers.
15 # Redistribution and use in source and binary forms, with or without
16 # modification, are permitted provided that the following conditions
18 # 1. Redistributions of source code must retain the above copyright
19 # notice, this list of conditions and the following disclaimer.
20 # 2. Redistributions in binary form must reproduce the above copyright
21 # notice, this list of conditions and the following disclaimer in the
22 # documentation and/or other materials provided with the distribution.
23 # 3. The name of the author may not be used to endorse or promote products
24 # derived from this software without specific prior written permission.
26 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
27 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
28 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
29 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
30 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
31 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
32 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
33 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
34 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
35 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
43 # Scales for strace slowdown. Make configurable!
44 my $scale_factor = 3.5;
48 my ($pid, $call, $args, $result, $time, $time_spent);
55 if (s/^(\d\d):(\d\d):(\d\d)(?:\.(\d\d\d\d\d\d))? //) {
56 $time = $1 * 3600 + $2 * 60 + $3;
58 $time = $time + $4 / 1000000;
61 } elsif (s/^(\d+)\.(\d\d\d\d\d\d) //) {
62 $time = $1 + ($2 / 1000000);
66 if (s/ <unfinished ...>$//) {
67 $unfinished{$pid} = $_;
71 if (s/^<... \S+ resumed> //) {
72 unless (exists $unfinished{$pid}) {
73 print STDERR "$0: $ARGV: cannot find start of resumed call on line $.";
76 $_ = $unfinished{$pid} . $_;
77 delete $unfinished{$pid};
80 if (/^--- SIG(\S+) (.*) ---$/) {
81 # $pid received signal $1
82 # currently we don't do anything with this
86 if (/^\+\+\+ killed by SIG(\S+) \+\+\+$/) {
87 # $pid received signal $1
88 handle_killed($pid, $time);
92 if (/^\+\+\+ exited with (\d+) \+\+\+$/) {
94 # currently we don't do anything with this
98 ($call, $args, $result) = /(\S+)\((.*)\)\s+= (.*)$/;
99 if ($result =~ /^(.*) <([0-9.]*)>$/) {
100 ($result, $time_spent) = ($1, $2);
102 unless (defined $result) {
103 print STDERR "$0: $ARGV: $.: cannot parse line.\n";
107 handle_trace($pid, $call, $args, $result, $time);
119 if ($in =~ s/^\\(.)//) {
121 } elsif ($in =~ s/^\"//) {
122 if ($in =~ s/^\.\.\.//) {
123 return ("$result...", $in);
125 return ($result, $in);
126 } elsif ($in =~ s/([^\\\"]*)//) {
137 if ($in =~ s/^\"//) {
139 ($tmp, $in) = parse_str($in);
140 if (not defined $tmp) {
141 print STDERR "$0: $ARGV: $.: cannot parse string.\n";
145 } elsif ($in =~ s/^0x([[:xdigit:]]+)//) {
146 return (hex $1, $in);
147 } elsif ($in =~ s/^(\d+)//) {
148 return (int $1, $in);
150 print STDERR "$0: $ARGV: $.: unrecognized element.\n";
161 if ($in =~ s/^\[//) {
163 if ($in =~ s,^/\* (\d+) vars \*/\],,) {
166 while ($in !~ s/^\]//) {
167 ($tmp, $in) = parse_one($in);
168 defined $tmp or return undef;
170 unless ($in =~ /^\]/ or $in =~ s/^, //) {
171 print STDERR "$0: $ARGV: $.: missing comma in array.\n";
174 if ($in =~ s/^\.\.\.//) {
178 push @args, \@subarr;
180 } elsif ($in =~ s/^\{//) {
182 while ($in !~ s/^\}//) {
184 unless ($in =~ s/^(\w+)=//) {
185 print STDERR "$0: $ARGV: $.: struct field expected.\n";
189 ($tmp, $in) = parse_one($in);
190 defined $tmp or return undef;
191 $subhash{$key} = $tmp;
192 unless ($in =~ s/, //) {
193 print STDERR "$0: $ARGV: $.: missing comma in struct.\n";
197 push @args, \%subhash;
199 ($tmp, $in) = parse_one($in);
200 defined $tmp or return undef;
203 unless (length($in) == 0 or $in =~ s/^, //) {
204 print STDERR "$0: $ARGV: $.: missing comma.\n";
214 # process info, indexed by pid.
217 # seq clones, forks and execs for this pid, in sequence (array)
219 # filename and argv (from latest exec)
220 # basename (derived from filename)
221 # argv[0] is modified to add the basename if it differs from the 0th argument.
226 my ($pid, $call, $args, $result, $time) = @_;
227 my $pid_fqname = $pid . "-" . $time;
229 if (defined $time and not defined $running_fqname{$pid}) {
230 $pr{$pid_fqname}{start} = $time;
231 $running_fqname{$pid} = $pid_fqname;
234 $pid_fqname = $running_fqname{$pid};
236 if ($call eq 'execve') {
237 return if $result ne '0';
239 my ($filename, $argv) = parseargs($args);
240 my ($basename) = $filename =~ m/([^\/]*)$/;
241 if ($basename ne $$argv[0]) {
242 $$argv[0] = "$basename($$argv[0])";
244 my $seq = $pr{$pid_fqname}{seq};
245 $seq = [] if not defined $seq;
247 push @$seq, ['EXEC', $filename, $argv];
249 $pr{$pid_fqname}{seq} = $seq;
250 } elsif ($call eq 'fork' || $call eq 'clone' || $call eq 'vfork') {
251 return if $result == 0;
253 my $seq = $pr{$pid_fqname}{seq};
254 my $result_fqname= $result . "-" . $time;
255 $seq = [] if not defined $seq;
256 push @$seq, ['FORK', $result_fqname];
257 $pr{$pid_fqname}{seq} = $seq;
258 $pr{$result_fqname}{start} = $time;
259 $pr{$result_fqname}{parent} = $pid_fqname;
260 $pr{$result_fqname}{seq} = [];
261 $running_fqname{$result} = $result_fqname;
262 } elsif ($call eq '_exit' || $call eq 'exit_group') {
263 $pr{$running_fqname{$pid}}{end} = $time if defined $time and not defined $pr{$running_fqname{$pid}}{end};
264 delete $running_fqname{$pid};
269 my ($pid, $time) = @_;
270 $pr{$pid}{end} = $time if defined $time and not defined $pr{$pid}{end};
275 my $seq = $pr{$pid}{seq};
277 for my $elem (@$seq) {
278 if ($$elem[0] eq 'EXEC') {
279 my $argv = $$elem[2];
280 print "$$elem[0] $$elem[1] @$argv\n";
281 } elsif ($$elem[0] eq 'FORK') {
282 print "$$elem[0] $$elem[1]\n";
291 my $seq = $pr{$pid}{seq};
293 for my $elem (@$seq) {
294 if ($$elem[0] eq 'EXEC') {
301 sub display_pid_trace {
302 my ($pid, $lead) = @_;
304 my @seq = @{$pr{$pid}{seq}};
307 if (not defined first_exec($pid)) {
308 unshift @seq, ['EXEC', '', ['(anon)'] ];
311 if (defined $pr{$pid}{start} and defined $pr{$pid}{end}) {
312 $elapsed = $pr{$pid}{end} - $pr{$pid}{start};
313 $elapsed /= $scale_factor;
315 $elapsed = sprintf("%0.02f", $elapsed);
317 $elapsed = int $elapsed;
321 for my $elem (@seq) {
323 if ($$elem[0] eq 'EXEC') {
324 my $argv = $$elem[2];
325 if (defined $elapsed) {
326 print "$lead [$elapsed] $pid @$argv\n";
329 print "$lead $pid @$argv\n";
331 } elsif ($$elem[0] eq 'FORK') {
334 display_pid_trace($$elem[1], "$lead--+--");
336 display_pid_trace($$elem[1], "$lead +--");
338 } elsif ($i == @seq) {
339 display_pid_trace($$elem[1], "$lead `--");
341 display_pid_trace($$elem[1], "$lead +--");
355 $startpid = (keys %pr)[0];
356 while ($pr{$startpid}{parent}) {
357 $startpid = $pr{$startpid}{parent};
360 display_pid_trace($startpid, "");