granicus.if.org Git - strace/blob - 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 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 }