#!/usr/bin/perl -w

#
# gdbtrace.pl - trace an executable using gdb
#
# Uses the "gdb annotations" feature to grab the interesting events.
#
# The executable must have been compiled with the debugging information (-g).
#
# Author and Copyright: jhi@iki.fi
# License: This utility is licensed under the same terms as Perl.
#

use strict;

use vars qw($VERSION);

$VERSION = sprintf "%d.%d", q$Revision: 1.1 $ =~ /(\d+)/g; # jhi@iki.fi

use File::Temp qw(tempfile);
use Getopt::Long qw(:config require_order);

my $Exe;
my $Break;
my $Outfn;
my $Outfh;
my $Trace;
my $TraceFrame;
my $TraceSource;
my $Showhelp;

my ($Cmdfh, $Cmdfn) = tempfile("gdb-XXXXXX", SUFFIX => '.cmd', UNLINK => 1);

my $BreakDefault = "main";
my $TraceDefault = "f";

sub die_with_usage {
    my $code = @_ ? shift : 1;
    warn <<__EOU__;
$0: Trace an executable (compiled with -g) using gdb.
$0: Usage: $0 [--break=...] [--trace=fs] [--outfile=...] exe arg ...
The break (where to start tracing) defaults to $BreakDefault.
The trace is one or more of f (frame) and s (source code line).
The outfile defaults to exe.gdbtrace (use "-" for STDOUT).
The remaining arguments are the executable and its arguments.
A function frame means entering the context of a function,
either when the function is called, or when a return is made back to it.
Caveat/1: the execution is slowed by many magnitudes (1000x, or so).
Caveat/2: the trace output can be HUGE.
Caveat/3: your and gdb's outputs might get mixed.
Caveat/4: interrupting the program might seriously confuse your tty.
Caveat/5: offering terminal input to the tracing might seriously do the same.
Caveat/6: the tracing cannot be backgrounded (see Caveats 4 and 5).
Caveat/7: you might see garbage output not unlike this when execution ends:
  error-begin
  gdb-a8gwCa.cmd:9: Error in sourced command file:
  The program is not being run.
__EOU__
    exit($code);
}

sub handle_options {
    die_with_usage(1)
	unless GetOptions('break=s'   => \$Break,
			  'trace=s'   => \$Trace,
			  'outfile=s' => \$Outfn,
			  'help'      => \$Showhelp);
    die_with_usage(0) if $Showhelp || @ARGV == 0;
    $Exe   = shift(@ARGV);
    $Break = $BreakDefault   unless defined $Break;
    $Trace = $TraceDefault   unless defined $Trace;
    $Outfn = "$Exe.gdbtrace" unless defined $Outfn;
    $TraceFrame  = $Trace =~ /f/;
    $TraceSource = $Trace =~ /s/;
    if ($Outfn eq "-") {
	$Outfh = *STDOUT;
    } else {
	unless (open($Outfh, ">$Outfn")) {
	    die qq[$0: failed to open ">$Outfn": $!\n];
	}
    }
}

sub create_gdb_cmd {
    die qq[$0: failed to create temp file for gdb commands\n]
	unless defined $Cmdfh;
    my @argv = map { / / ? qq["$_"] : $_ }  @ARGV; # Simple quoting attempt.
    print $Cmdfh <<__EOF__;
define traceit
  set height 0
  b $Break
  run @argv
  while 1
    step 1
  end
end
traceit
__EOF__
    close($Cmdfh);
}

sub run_gdb {
    my $gdbcmd = "gdb --ann=3 --command=$Cmdfn $Exe |";
    my @argv = ($Exe, @ARGV);
    print qq[- Starting gdb, running "@argv", log "$Outfn".\n];
    my @buffer;
    my $running;
    my $frame;
    if (open(my $gdbfh, $gdbcmd)) {
	my $frame;
	while (<$gdbfh>) {
	    push @buffer, $_;
	    my ($ann, $arg);
	    if (@buffer == 2) {
		if ($buffer[1] =~ /^\cZ\cZ(.+)/) { # GDB annotation.
		    $ann = $1;
		    if ($ann =~ /^(\S+) (.+)/) {
			$ann = $1;
			$arg = $2;
		    }
		    $buffer[0] =~ s/\n$//;
		    pop @buffer;
		}
		if ($TraceFrame && $running) {
		    unless ($buffer[0] =~ /^\s*$/ ||
			    $buffer[0] =~ /Reading symbols/) { # Probably more.
			$buffer[0] =~ s/^Breakpoint 1, //;
			print $Outfh "f $buffer[0]";
		    }
		}
		shift @buffer;
	    }
	    if (defined $ann) {
		# TODO: signalled, signal
		# TODO: stopping tracing when ...
		# TODO: tracing only inside certain functions
		if ($ann eq 'starting') {
		    $running = 1;
		} elsif ($ann eq 'frame-begin') {
		    $frame = 1;
		} elsif ($ann eq 'frame-source-end') {
		    $frame = 0;
		} elsif ($ann eq 'source') {
		    print $Outfh "s $arg\n" if $TraceSource;
		} elsif ($ann eq 'exited') {
		    print $Outfh "exit $arg\n";
		    last;
		}
		undef $ann;
	    }
	}
	if (@buffer) {
	    print $Outfh @buffer if $running;
	}
	close($gdbfh);
	print qq[- Finished gdb.\n];
    } else {
	die qq[$0: open "$gdbcmd" failed: $!\n];
    }
}

sub main {
    handle_options();
    create_gdb_cmd();
    run_gdb();
    exit(0);
}

main();

=head1 PREREQUISITES

File::Temp
Getopt::Long
strict
vars

=head1 COREQUISITES

=head1 SCRIPT CATEGORIES

    Development::Tracing

=head1 README

Trace an executable using gdb.  Uses the "gdb annotations" feature to
grab the interesting events.  The executable must have been compiled
with the debugging information (-g).

=head1 COPYRIGHT

(C) 2005 by Jarkko Hietaniemi <jhi@iki.fi>

All rights reserved. You may distribute this code under the terms
of either the GNU General Public License or the Artistic License,
as specified in the Perl README file.

=cut