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