# 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>.
+# Copyright (c) 1998 by Richard Braakman <dark@xs4all.nl>.
+# Copyright (c) 1998-2017 The strace developers.
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-#
-# $Id$
+
+use strict;
+use warnings;
my %unfinished;
+my $floatform;
# Scales for strace slowdown. Make configurable!
my $scale_factor = 3.5;
+my %running_fqname;
while (<>) {
- my ($pid, $call, $args, $result, $time);
+ my ($pid, $call, $args, $result, $time, $time_spent);
chop;
+ $floatform = 0;
s/^(\d+)\s+//;
$pid = $1;
delete $unfinished{$pid};
}
- if (/^--- SIG(\S+) \(.*\) ---$/) {
+ if (/^--- SIG(\S+) (.*) ---$/) {
# $pid received signal $1
# currently we don't do anything with this
next;
next;
}
+ if (/^\+\+\+ exited with (\d+) \+\+\+$/) {
+ # $pid exited $1
+ # currently we don't do anything with this
+ next;
+ }
+
($call, $args, $result) = /(\S+)\((.*)\)\s+= (.*)$/;
+ if ($result =~ /^(.*) <([0-9.]*)>$/) {
+ ($result, $time_spent) = ($1, $2);
+ }
unless (defined $result) {
print STDERR "$0: $ARGV: $.: cannot parse line.\n";
next;
return (undef, $in);
}
}
-}
+}
sub parse_one {
my ($in) = @_;
if ($in =~ s/^\"//) {
+ my $tmp;
($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+)//) {
+ } elsif ($in =~ s/^0x([[:xdigit:]]+)//) {
return (hex $1, $in);
} elsif ($in =~ s/^(\d+)//) {
return (int $1, $in);
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:
+# fields:
# parent pid number
-# seq forks and execs for this pid, in sequence (array)
-
+# seq clones, 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.
sub handle_trace {
my ($pid, $call, $args, $result, $time) = @_;
- my $p;
+ my $pid_fqname = $pid . "-" . $time;
- if (defined $time and not defined $pr{$pid}{start}) {
- $pr{$pid}{start} = $time;
+ if (defined $time and not defined $running_fqname{$pid}) {
+ $pr{$pid_fqname}{start} = $time;
+ $running_fqname{$pid} = $pid_fqname;
}
+ $pid_fqname = $running_fqname{$pid};
+
if ($call eq 'execve') {
- return if $result != 0;
+ return if $result ne '0';
my ($filename, $argv) = parseargs($args);
- ($basename) = $filename =~ m/([^\/]*)$/;
+ my ($basename) = $filename =~ m/([^\/]*)$/;
if ($basename ne $$argv[0]) {
$$argv[0] = "$basename($$argv[0])";
- }
- my $seq = $pr{$pid}{seq};
+ }
+ my $seq = $pr{$pid_fqname}{seq};
$seq = [] if not defined $seq;
push @$seq, ['EXEC', $filename, $argv];
- $pr{$pid}{seq} = $seq;
+ $pr{$pid_fqname}{seq} = $seq;
} elsif ($call eq 'fork' || $call eq 'clone' || $call eq 'vfork') {
return if $result == 0;
- my $seq = $pr{$pid}{seq};
+ my $seq = $pr{$pid_fqname}{seq};
+ my $result_fqname= $result . "-" . $time;
$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;
+ push @$seq, ['FORK', $result_fqname];
+ $pr{$pid_fqname}{seq} = $seq;
+ $pr{$result_fqname}{start} = $time;
+ $pr{$result_fqname}{parent} = $pid_fqname;
+ $pr{$result_fqname}{seq} = [];
+ $running_fqname{$result} = $result_fqname;
+ } elsif ($call eq '_exit' || $call eq 'exit_group') {
+ $pr{$running_fqname{$pid}}{end} = $time if defined $time and not defined $pr{$running_fqname{$pid}}{end};
+ delete $running_fqname{$pid};
}
}
sub handle_killed {
my ($pid, $time) = @_;
- $pr{$pid}{end} = $time if defined $time;
+ $pr{$pid}{end} = $time if defined $time and not defined $pr{$pid}{end};
}
sub straight_seq {
my ($pid) = @_;
my $seq = $pr{$pid}{seq};
- for $elem (@$seq) {
+ for my $elem (@$seq) {
if ($$elem[0] eq 'EXEC') {
my $argv = $$elem[2];
print "$$elem[0] $$elem[1] @$argv\n";
my ($pid) = @_;
my $seq = $pr{$pid}{seq};
- for $elem (@$seq) {
+ for my $elem (@$seq) {
if ($$elem[0] eq 'EXEC') {
return $elem;
}
}
}
- for $elem (@seq) {
+ for my $elem (@seq) {
$i++;
if ($$elem[0] eq 'EXEC') {
my $argv = $$elem[2];
if (defined $elapsed) {
- print "$lead [$elapsed] @$argv\n";
+ print "$lead [$elapsed] $pid @$argv\n";
undef $elapsed;
} else {
- print "$lead @$argv\n";
+ print "$lead $pid @$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 +--");
- }
+ 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($startpid, "");
}
-
projects / strace / blobdiff