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 # Copyright (c) 1998 by Richard Braakman <dark@xs4all.nl>.
  13 # Copyright (c) 1998-2017 The strace developers.
  14
  15 # Redistribution and use in source and binary forms, with or without
  16 # modification, are permitted provided that the following conditions
  17 # are met:
  18 # 1. Redistributions of source code must retain the above copyright
  19 #    notice, this list of conditions and the following disclaimer.
  20 # 2. Redistributions in binary form must reproduce the above copyright
  21 #    notice, this list of conditions and the following disclaimer in the
  22 #    documentation and/or other materials provided with the distribution.
  23 # 3. The name of the author may not be used to endorse or promote products
  24 #    derived from this software without specific prior written permission.
  25 #
  26 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
  27 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  28 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  29 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
  30 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  31 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  32 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  33 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  34 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  35 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  36
  37 use strict;
  38 use warnings;
  39
  40 my %unfinished;
  41 my $floatform;
  42
  43 # Scales for strace slowdown.  Make configurable!
  44 my $scale_factor = 3.5;
  45 my %running_fqname;
  46
  47 while (<>) {
  48     my ($pid, $call, $args, $result, $time, $time_spent);
  49     chop;
  50     $floatform = 0;
  51
  52     s/^(\d+)\s+//;
  53     $pid = $1;
  54
  55     if (s/^(\d\d):(\d\d):(\d\d)(?:\.(\d\d\d\d\d\d))? //) {
  56         $time = $1 * 3600 + $2 * 60 + $3;
  57         if (defined $4) {
  58             $time = $time + $4 / 1000000;
  59             $floatform = 1;
  60         }
  61     } elsif (s/^(\d+)\.(\d\d\d\d\d\d) //) {
  62         $time = $1 + ($2 / 1000000);
  63         $floatform = 1;
  64     }
  65
  66     if (s/ <unfinished ...>$//) {
  67         $unfinished{$pid} = $_;
  68         next;
  69     }
  70
  71     if (s/^<... \S+ resumed> //) {
  72         unless (exists $unfinished{$pid}) {
  73             print STDERR "$0: $ARGV: cannot find start of resumed call on line $.";
  74             next;
  75         }
  76         $_ = $unfinished{$pid} . $_;
  77         delete $unfinished{$pid};
  78     }
  79
  80     if (/^--- SIG(\S+) (.*) ---$/) {
  81         # $pid received signal $1
  82         # currently we don't do anything with this
  83         next;
  84     }
  85
  86     if (/^\+\+\+ killed by SIG(\S+) \+\+\+$/) {
  87         # $pid received signal $1
  88         handle_killed($pid, $time);
  89         next;
  90     }
  91
  92     if (/^\+\+\+ exited with (\d+) \+\+\+$/) {
  93         # $pid exited $1
  94         # currently we don't do anything with this
  95         next;
  96     }
  97
  98     ($call, $args, $result) = /(\S+)\((.*)\)\s+= (.*)$/;
  99     if ($result =~ /^(.*) <([0-9.]*)>$/) {
 100         ($result, $time_spent) = ($1, $2);
 101     }
 102     unless (defined $result) {
 103         print STDERR "$0: $ARGV: $.: cannot parse line.\n";
 104         next;
 105     }
 106
 107     handle_trace($pid, $call, $args, $result, $time);
 108 }
 109
 110 display_trace();
 111
 112 exit 0;
 113
 114 sub parse_str {
 115     my ($in) = @_;
 116     my $result = "";
 117
 118     while (1) {
 119         if ($in =~ s/^\\(.)//) {
 120             $result .= $1;
 121         } elsif ($in =~ s/^\"//) {
 122             if ($in =~ s/^\.\.\.//) {
 123                 return ("$result...", $in);
 124             }
 125             return ($result, $in);
 126         } elsif ($in =~ s/([^\\\"]*)//) {
 127             $result .= $1;
 128         } else {
 129             return (undef, $in);
 130         }
 131     }
 132 }
 133
 134 sub parse_one {
 135     my ($in) = @_;
 136
 137     if ($in =~ s/^\"//) {
 138         my $tmp;
 139         ($tmp, $in) = parse_str($in);
 140         if (not defined $tmp) {
 141             print STDERR "$0: $ARGV: $.: cannot parse string.\n";
 142             return (undef, $in);
 143         }
 144         return ($tmp, $in);
 145     } elsif ($in =~ s/^0x([[:xdigit:]]+)//) {
 146         return (hex $1, $in);
 147     } elsif ($in =~ s/^(\d+)//) {
 148         return (int $1, $in);
 149     } else {
 150         print STDERR "$0: $ARGV: $.: unrecognized element.\n";
 151         return (undef, $in);
 152     }
 153 }
 154
 155 sub parseargs {
 156     my ($in) = @_;
 157     my @args = ();
 158     my $tmp;
 159
 160     while (length $in) {
 161         if ($in =~ s/^\[//) {
 162             my @subarr = ();
 163             if ($in =~ s,^/\* (\d+) vars \*/\],,) {
 164                 push @args, $1;
 165             } else {
 166                 while ($in !~ s/^\]//) {
 167                     ($tmp, $in) = parse_one($in);
 168                     defined $tmp or return undef;
 169                     push @subarr, $tmp;
 170                     unless ($in =~ /^\]/ or $in =~ s/^, //) {
 171                         print STDERR "$0: $ARGV: $.: missing comma in array.\n";
 172                         return undef;
 173                     }
 174                     if ($in =~ s/^\.\.\.//) {
 175                         push @subarr, "...";
 176                     }
 177                 }
 178                 push @args, \@subarr;
 179             }
 180         } elsif ($in =~ s/^\{//) {
 181             my %subhash = ();
 182             while ($in !~ s/^\}//) {
 183                 my $key;
 184                 unless ($in =~ s/^(\w+)=//) {
 185                     print STDERR "$0: $ARGV: $.: struct field expected.\n";
 186                     return undef;
 187                 }
 188                 $key = $1;
 189                 ($tmp, $in) = parse_one($in);
 190                 defined $tmp or return undef;
 191                 $subhash{$key} = $tmp;
 192                 unless ($in =~ s/, //) {
 193                     print STDERR "$0: $ARGV: $.: missing comma in struct.\n";
 194                     return undef;
 195                 }
 196             }
 197             push @args, \%subhash;
 198         } else {
 199             ($tmp, $in) = parse_one($in);
 200             defined $tmp or return undef;
 201             push @args, $tmp;
 202         }
 203         unless (length($in) == 0 or $in =~ s/^, //) {
 204             print STDERR "$0: $ARGV: $.: missing comma.\n";
 205             return undef;
 206         }
 207     }
 208     return @args;
 209 }
 210
 211
 212 my $depth = "";
 213
 214 # process info, indexed by pid.
 215 # fields:
 216 #    parent         pid number
 217 #    seq            clones, forks and execs for this pid, in sequence  (array)
 218
 219 #  filename and argv (from latest exec)
 220 #  basename (derived from filename)
 221 # argv[0] is modified to add the basename if it differs from the 0th argument.
 222
 223 my %pr;
 224
 225 sub handle_trace {
 226     my ($pid, $call, $args, $result, $time) = @_;
 227     my $pid_fqname = $pid . "-" . $time;
 228
 229     if (defined $time and not defined $running_fqname{$pid}) {
 230         $pr{$pid_fqname}{start} = $time;
 231         $running_fqname{$pid} = $pid_fqname;
 232     }
 233
 234     $pid_fqname = $running_fqname{$pid};
 235
 236     if ($call eq 'execve') {
 237         return if $result ne '0';
 238
 239         my ($filename, $argv) = parseargs($args);
 240         my ($basename) = $filename =~ m/([^\/]*)$/;
 241         if ($basename ne $$argv[0]) {
 242             $$argv[0] = "$basename($$argv[0])";
 243         }
 244         my $seq = $pr{$pid_fqname}{seq};
 245         $seq = [] if not defined $seq;
 246
 247         push @$seq, ['EXEC', $filename, $argv];
 248
 249         $pr{$pid_fqname}{seq} = $seq;
 250     } elsif ($call eq 'fork' || $call eq 'clone' || $call eq 'vfork') {
 251         return if $result == 0;
 252
 253         my $seq = $pr{$pid_fqname}{seq};
 254         my $result_fqname= $result . "-" . $time;
 255         $seq = [] if not defined $seq;
 256         push @$seq, ['FORK', $result_fqname];
 257         $pr{$pid_fqname}{seq} = $seq;
 258         $pr{$result_fqname}{start} = $time;
 259         $pr{$result_fqname}{parent} = $pid_fqname;
 260         $pr{$result_fqname}{seq} = [];
 261         $running_fqname{$result} = $result_fqname;
 262     } elsif ($call eq '_exit' || $call eq 'exit_group') {
 263         $pr{$running_fqname{$pid}}{end} = $time if defined $time and not defined $pr{$running_fqname{$pid}}{end};
 264         delete $running_fqname{$pid};
 265     }
 266 }
 267
 268 sub handle_killed {
 269     my ($pid, $time) = @_;
 270     $pr{$pid}{end} = $time if defined $time and not defined $pr{$pid}{end};
 271 }
 272
 273 sub straight_seq {
 274     my ($pid) = @_;
 275     my $seq = $pr{$pid}{seq};
 276
 277     for my $elem (@$seq) {
 278         if ($$elem[0] eq 'EXEC') {
 279             my $argv = $$elem[2];
 280             print "$$elem[0] $$elem[1] @$argv\n";
 281         } elsif ($$elem[0] eq 'FORK') {
 282             print "$$elem[0] $$elem[1]\n";
 283         } else {
 284             print "$$elem[0]\n";
 285         }
 286     }
 287 }
 288
 289 sub first_exec {
 290     my ($pid) = @_;
 291     my $seq = $pr{$pid}{seq};
 292
 293     for my $elem (@$seq) {
 294         if ($$elem[0] eq 'EXEC') {
 295             return $elem;
 296         }
 297     }
 298     return undef;
 299 }
 300
 301 sub display_pid_trace {
 302     my ($pid, $lead) = @_;
 303     my $i = 0;
 304     my @seq = @{$pr{$pid}{seq}};
 305     my $elapsed;
 306
 307     if (not defined first_exec($pid)) {
 308         unshift @seq, ['EXEC', '', ['(anon)'] ];
 309     }
 310
 311     if (defined $pr{$pid}{start} and defined $pr{$pid}{end}) {
 312         $elapsed = $pr{$pid}{end} - $pr{$pid}{start};
 313         $elapsed /= $scale_factor;
 314         if ($floatform) {
 315             $elapsed = sprintf("%0.02f", $elapsed);
 316         } else {
 317             $elapsed = int $elapsed;
 318         }
 319     }
 320
 321     for my $elem (@seq) {
 322         $i++;
 323         if ($$elem[0] eq 'EXEC') {
 324             my $argv = $$elem[2];
 325             if (defined $elapsed) {
 326                 print "$lead [$elapsed] $pid @$argv\n";
 327                 undef $elapsed;
 328             } else {
 329                 print "$lead $pid @$argv\n";
 330             }
 331         } elsif ($$elem[0] eq 'FORK') {
 332             if ($i == 1) {
 333                 if ($lead =~ /-$/) {
 334                     display_pid_trace($$elem[1], "$lead--+--");
 335                 } else {
 336                     display_pid_trace($$elem[1], "$lead  +--");
 337                 }
 338             } elsif ($i == @seq) {
 339                 display_pid_trace($$elem[1], "$lead  `--");
 340             } else {
 341                 display_pid_trace($$elem[1], "$lead  +--");
 342             }
 343         }
 344         if ($i == 1) {
 345             $lead =~ s/\`--/   /g;
 346             $lead =~ s/-/ /g;
 347             $lead =~ s/\+/|/g;
 348         }
 349     }
 350 }
 351
 352 sub display_trace {
 353     my ($startpid) = @_;
 354
 355     $startpid = (keys %pr)[0];
 356     while ($pr{$startpid}{parent}) {
 357         $startpid = $pr{$startpid}{parent};
 358     }
 359
 360     display_pid_trace($startpid, "");
 361 }