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 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 }