blob: d57e76863e585b3a0fdf61ad6b7e8032e99476a4 [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.
Wichert Akkerman9ce1a631999-08-29 23:15:07 +000035
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 }
Denys Vlasenko402eeb62009-01-02 13:03:44 +0000116}
Wichert Akkerman9ce1a631999-08-29 23:15:07 +0000117
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;
Denys Vlasenko402eeb62009-01-02 13:03:44 +0000189 }
Wichert Akkerman9ce1a631999-08-29 23:15:07 +0000190 }
191 return @args;
192}
Denys Vlasenko402eeb62009-01-02 13:03:44 +0000193
Wichert Akkerman9ce1a631999-08-29 23:15:07 +0000194
195my $depth = "";
196
197# process info, indexed by pid.
Denys Vlasenko402eeb62009-01-02 13:03:44 +0000198# fields:
Wichert Akkerman9ce1a631999-08-29 23:15:07 +0000199# parent pid number
200# seq forks and execs for this pid, in sequence (array)
Denys Vlasenko402eeb62009-01-02 13:03:44 +0000201
Wichert Akkerman9ce1a631999-08-29 23:15:07 +0000202# 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;
Roland McGrathec407e32005-12-02 04:27:26 +0000230 } elsif ($call eq 'fork' || $call eq 'clone' || $call eq 'vfork') {
Wichert Akkerman9ce1a631999-08-29 23:15:07 +0000231 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 =~ /-$/) {
Dmitry V. Levin414fe7d2009-07-08 11:21:17 +0000309 display_pid_trace($$elem[1], "$lead--+--");
Wichert Akkerman9ce1a631999-08-29 23:15:07 +0000310 } else {
Dmitry V. Levin414fe7d2009-07-08 11:21:17 +0000311 display_pid_trace($$elem[1], "$lead +--");
Wichert Akkerman9ce1a631999-08-29 23:15:07 +0000312 }
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}