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