user/strace/strace-graph

   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@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$
  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' || $call eq 'clone' || $call eq 'vfork') {
 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 }