#!/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: [email protected]
# 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; # [email protected]

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 <[email protected]>

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