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