strace-graph - platform/external/strace.git - Git at Google

 #!/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.

 # 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
 # are met:
 # 1. Redistributions of source code must retain the above copyright
 #    notice, this list of conditions and the following disclaimer.
 # 2. Redistributions in binary form must reproduce the above copyright
 #    notice, this list of conditions and the following disclaimer in the
 #    documentation and/or other materials provided with the distribution.
 # 3. The name of the author may not be used to endorse or promote products
 #    derived from this software without specific prior written permission.
 #
 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 # 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.

 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, $time_spent);
     chop;
     $floatform = 0;

     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;
     }

     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;
     }

     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/^\"//) {
 	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([[:xdigit:]]+)//) {
 	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            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.

 my %pr;

 sub handle_trace {
     my ($pid, $call, $args, $result, $time) = @_;
     my $pid_fqname = $pid . "-" . $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 ne '0';

 	my ($filename, $argv) = parseargs($args);
 	my ($basename) = $filename =~ m/([^\/]*)$/;
 	if ($basename ne $$argv[0]) {
 	    $$argv[0] = "$basename($$argv[0])";
 	}
 	my $seq = $pr{$pid_fqname}{seq};
 	$seq = [] if not defined $seq;

 	push @$seq, ['EXEC', $filename, $argv];

 	$pr{$pid_fqname}{seq} = $seq;
     } elsif ($call eq 'fork' || $call eq 'clone' || $call eq 'vfork') {
 	return if $result == 0;

 	my $seq = $pr{$pid_fqname}{seq};
 	my $result_fqname= $result . "-" . $time;
 	$seq = [] if not defined $seq;
 	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 and not defined $pr{$pid}{end};
 }

 sub straight_seq {
     my ($pid) = @_;
     my $seq = $pr{$pid}{seq};

     for my $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 my $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 my $elem (@seq) {
 	$i++;
 	if ($$elem[0] eq 'EXEC') {
 	    my $argv = $$elem[2];
 	    if (defined $elapsed) {
 		print "$lead [$elapsed] $pid @$argv\n";
 		undef $elapsed;
 	    } else {
 		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  +--");
 		}
 	    } 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, "");
 }
	#!/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.

	# 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
	# are met:
	# 1. Redistributions of source code must retain the above copyright
	# notice, this list of conditions and the following disclaimer.
	# 2. Redistributions in binary form must reproduce the above copyright
	# notice, this list of conditions and the following disclaimer in the
	# documentation and/or other materials provided with the distribution.
	# 3. The name of the author may not be used to endorse or promote products
	# derived from this software without specific prior written permission.
	#
	# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
	# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
	# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
	# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
	# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
	# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
	# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
	# 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.

	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, $time_spent);
	chop;
	$floatform = 0;

	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;
	}

	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;
	}

	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/^\"//) {
	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([[:xdigit:]]+)//) {
	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 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.

	my %pr;

	sub handle_trace {
	my ($pid, $call, $args, $result, $time) = @_;
	my $pid_fqname = $pid . "-" . $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 ne '0';

	my ($filename, $argv) = parseargs($args);
	my ($basename) = $filename =~ m/([^\/]*)$/;
	if ($basename ne $$argv[0]) {
	$$argv[0] = "$basename($$argv[0])";
	}
	my $seq = $pr{$pid_fqname}{seq};
	$seq = [] if not defined $seq;

	push @$seq, ['EXEC', $filename, $argv];

	$pr{$pid_fqname}{seq} = $seq;
	} elsif ($call eq 'fork' \|\| $call eq 'clone' \|\| $call eq 'vfork') {
	return if $result == 0;

	my $seq = $pr{$pid_fqname}{seq};
	my $result_fqname= $result . "-" . $time;
	$seq = [] if not defined $seq;
	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 and not defined $pr{$pid}{end};
	}

	sub straight_seq {
	my ($pid) = @_;
	my $seq = $pr{$pid}{seq};

	for my $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 my $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 my $elem (@seq) {
	$i++;
	if ($$elem[0] eq 'EXEC') {
	my $argv = $$elem[2];
	if (defined $elapsed) {
	print "$lead [$elapsed] $pid @$argv\n";
	undef $elapsed;
	} else {
	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 +--");
	}
	} 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, "");
	}