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 my %unfinished;
     37 
     38 # Scales for strace slowdown.  Make configurable!
     39 my $scale_factor = 3.5;
     40 
     41 while (<>) {
     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 
     94 display_trace();
     95 
     96 exit 0;
     97 
     98 sub 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 
    118 sub 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 
    138 sub 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 
    195 my $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 
    206 my %pr;
    207 
    208 sub 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 
    243 sub handle_killed {
    244     my ($pid, $time) = @_;
    245     $pr{$pid}{end} = $time if defined $time;
    246 }
    247 
    248 sub 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 
    264 sub 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 
    276 sub 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 
    327 sub 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