Catching up on my mail-backlog, see ChangeLog for details

1 files changed, 317 insertions, 0 deletions

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, "");
+}
+