Catching up on my mail-backlog, see ChangeLog for details
diff --git a/strace-graph b/strace-graph
new file mode 100755
index 0000000..a157a54
--- /dev/null
+++ b/strace-graph
@@ -0,0 +1,317 @@
+#!/usr/bin/perl
+
+# This script processes strace -f output. It displays a graph of invoked
+# subprocesses, and is useful for finding out what complex commands do.
+
+# You will probably want to invoke strace with -q as well, and with
+# -s 100 to get complete filenames.
+
+# The script can also handle the output with strace -t, -tt, or -ttt.
+# It will add elapsed time for each process in that case.
+
+# This script is Copyright (C) 1998 by Richard Braakman <dark@xs4all.nl>.
+# It is distributed under the GNU General Public License version 2 or,
+# at your option, any later version published by the Free Software Foundation.
+
+my %unfinished;
+
+# Scales for strace slowdown. Make configurable!
+my $scale_factor = 3.5;
+
+while (<>) {
+ my ($pid, $call, $args, $result, $time);
+ chop;
+
+ s/^(\d+)\s+//;
+ $pid = $1;
+
+ if (s/^(\d\d):(\d\d):(\d\d)(?:\.(\d\d\d\d\d\d))? //) {
+ $time = $1 * 3600 + $2 * 60 + $3;
+ if (defined $4) {
+ $time = $time + $4 / 1000000;
+ $floatform = 1;
+ }
+ } elsif (s/^(\d+)\.(\d\d\d\d\d\d) //) {
+ $time = $1 + ($2 / 1000000);
+ $floatform = 1;
+ }
+
+ if (s/ <unfinished ...>$//) {
+ $unfinished{$pid} = $_;
+ next;
+ }
+
+ if (s/^<... \S+ resumed> //) {
+ unless (exists $unfinished{$pid}) {
+ print STDERR "$0: $ARGV: cannot find start of resumed call on line $.";
+ next;
+ }
+ $_ = $unfinished{$pid} . $_;
+ delete $unfinished{$pid};
+ }
+
+ if (/^--- SIG(\S+) \(.*\) ---$/) {
+ # $pid received signal $1
+ # currently we don't do anything with this
+ next;
+ }
+
+ if (/^\+\+\+ killed by SIG(\S+) \+\+\+$/) {
+ # $pid received signal $1
+ handle_killed($pid, $time);
+ next;
+ }
+
+ ($call, $args, $result) = /(\S+)\((.*)\)\s+= (.*)$/;
+ unless (defined $result) {
+ print STDERR "$0: $ARGV: $.: cannot parse line.\n";
+ next;
+ }
+
+ handle_trace($pid, $call, $args, $result, $time);
+}
+
+display_trace();
+
+exit 0;
+
+sub parse_str {
+ my ($in) = @_;
+ my $result = "";
+
+ while (1) {
+ if ($in =~ s/^\\(.)//) {
+ $result .= $1;
+ } elsif ($in =~ s/^\"//) {
+ if ($in =~ s/^\.\.\.//) {
+ return ("$result...", $in);
+ }
+ return ($result, $in);
+ } elsif ($in =~ s/([^\\\"]*)//) {
+ $result .= $1;
+ } else {
+ return (undef, $in);
+ }
+ }
+}
+
+sub parse_one {
+ my ($in) = @_;
+
+ if ($in =~ s/^\"//) {
+ ($tmp, $in) = parse_str($in);
+ if (not defined $tmp) {
+ print STDERR "$0: $ARGV: $.: cannot parse string.\n";
+ return (undef, $in);
+ }
+ return ($tmp, $in);
+ } elsif ($in =~ s/^0x(\x+)//) {
+ return (hex $1, $in);
+ } elsif ($in =~ s/^(\d+)//) {
+ return (int $1, $in);
+ } else {
+ print STDERR "$0: $ARGV: $.: unrecognized element.\n";
+ return (undef, $in);
+ }
+}
+
+sub parseargs {
+ my ($in) = @_;
+ my @args = ();
+ my $tmp;
+
+ while (length $in) {
+ if ($in =~ s/^\[//) {
+ my @subarr = ();
+ if ($in =~ s,^/\* (\d+) vars \*/\],,) {
+ push @args, $1;
+ } else {
+ while ($in !~ s/^\]//) {
+ ($tmp, $in) = parse_one($in);
+ defined $tmp or return undef;
+ push @subarr, $tmp;
+ unless ($in =~ /^\]/ or $in =~ s/^, //) {
+ print STDERR "$0: $ARGV: $.: missing comma in array.\n";
+ return undef;
+ }
+ if ($in =~ s/^\.\.\.//) {
+ push @subarr, "...";
+ }
+ }
+ push @args, \@subarr;
+ }
+ } elsif ($in =~ s/^\{//) {
+ my %subhash = ();
+ while ($in !~ s/^\}//) {
+ my $key;
+ unless ($in =~ s/^(\w+)=//) {
+ print STDERR "$0: $ARGV: $.: struct field expected.\n";
+ return undef;
+ }
+ $key = $1;
+ ($tmp, $in) = parse_one($in);
+ defined $tmp or return undef;
+ $subhash{$key} = $tmp;
+ unless ($in =~ s/, //) {
+ print STDERR "$0: $ARGV: $.: missing comma in struct.\n";
+ return undef;
+ }
+ }
+ push @args, \%subhash;
+ } else {
+ ($tmp, $in) = parse_one($in);
+ defined $tmp or return undef;
+ push @args, $tmp;
+ }
+ unless (length($in) == 0 or $in =~ s/^, //) {
+ print STDERR "$0: $ARGV: $.: missing comma.\n";
+ return undef;
+ }
+ }
+ return @args;
+}
+
+
+my $depth = "";
+
+# process info, indexed by pid.
+# fields:
+# parent pid number
+# seq forks and execs for this pid, in sequence (array)
+
+# filename and argv (from latest exec)
+# basename (derived from filename)
+# argv[0] is modified to add the basename if it differs from the 0th argument.
+
+my %pr;
+
+sub handle_trace {
+ my ($pid, $call, $args, $result, $time) = @_;
+ my $p;
+
+ if (defined $time and not defined $pr{$pid}{start}) {
+ $pr{$pid}{start} = $time;
+ }
+
+ if ($call eq 'execve') {
+ return if $result != 0;
+
+ my ($filename, $argv) = parseargs($args);
+ ($basename) = $filename =~ m/([^\/]*)$/;
+ if ($basename ne $$argv[0]) {
+ $$argv[0] = "$basename($$argv[0])";
+ }
+ my $seq = $pr{$pid}{seq};
+ $seq = [] if not defined $seq;
+
+ push @$seq, ['EXEC', $filename, $argv];
+
+ $pr{$pid}{seq} = $seq;
+ } elsif ($call eq 'fork') {
+ return if $result == 0;
+
+ my $seq = $pr{$pid}{seq};
+ $seq = [] if not defined $seq;
+ push @$seq, ['FORK', $result];
+ $pr{$pid}{seq} = $seq;
+ $pr{$result}{parent} = $pid;
+ } elsif ($call eq '_exit') {
+ $pr{$pid}{end} = $time if defined $time;
+ }
+}
+
+sub handle_killed {
+ my ($pid, $time) = @_;
+ $pr{$pid}{end} = $time if defined $time;
+}
+
+sub straight_seq {
+ my ($pid) = @_;
+ my $seq = $pr{$pid}{seq};
+
+ for $elem (@$seq) {
+ if ($$elem[0] eq 'EXEC') {
+ my $argv = $$elem[2];
+ print "$$elem[0] $$elem[1] @$argv\n";
+ } elsif ($$elem[0] eq 'FORK') {
+ print "$$elem[0] $$elem[1]\n";
+ } else {
+ print "$$elem[0]\n";
+ }
+ }
+}
+
+sub first_exec {
+ my ($pid) = @_;
+ my $seq = $pr{$pid}{seq};
+
+ for $elem (@$seq) {
+ if ($$elem[0] eq 'EXEC') {
+ return $elem;
+ }
+ }
+ return undef;
+}
+
+sub display_pid_trace {
+ my ($pid, $lead) = @_;
+ my $i = 0;
+ my @seq = @{$pr{$pid}{seq}};
+ my $elapsed;
+
+ if (not defined first_exec($pid)) {
+ unshift @seq, ['EXEC', '', ['(anon)'] ];
+ }
+
+ if (defined $pr{$pid}{start} and defined $pr{$pid}{end}) {
+ $elapsed = $pr{$pid}{end} - $pr{$pid}{start};
+ $elapsed /= $scale_factor;
+ if ($floatform) {
+ $elapsed = sprintf("%0.02f", $elapsed);
+ } else {
+ $elapsed = int $elapsed;
+ }
+ }
+
+ for $elem (@seq) {
+ $i++;
+ if ($$elem[0] eq 'EXEC') {
+ my $argv = $$elem[2];
+ if (defined $elapsed) {
+ print "$lead [$elapsed] @$argv\n";
+ undef $elapsed;
+ } else {
+ print "$lead @$argv\n";
+ }
+ } elsif ($$elem[0] eq 'FORK') {
+ if ($i == 1) {
+ if ($lead =~ /-$/) {
+ display_pid_trace($$elem[1], "$lead--+--");
+ } else {
+ display_pid_trace($$elem[1], "$lead +--");
+ }
+ } elsif ($i == @seq) {
+ display_pid_trace($$elem[1], "$lead `--");
+ } else {
+ display_pid_trace($$elem[1], "$lead +--");
+ }
+ }
+ if ($i == 1) {
+ $lead =~ s/\`--/ /g;
+ $lead =~ s/-/ /g;
+ $lead =~ s/\+/|/g;
+ }
+ }
+}
+
+sub display_trace {
+ my ($startpid) = @_;
+
+ $startpid = (keys %pr)[0];
+ while ($pr{$startpid}{parent}) {
+ $startpid = $pr{$startpid}{parent};
+ }
+
+ display_pid_trace($startpid, "");
+}
+