#!/usr/bin/perl -sw
use strict;

#
# global variables
#
my %ENTITY;
my $BASE_ADDR = 0x08048000;

#
# read_file
#
sub parse_file($$;*)
{
  my $fn = shift;
  my $filename = shift;

  open(FILE, $filename) || die "Can't open $filename: $!";
  my @line;
  while(<FILE>)
  {
    s/\s*$//;
    push @line, $_;
  }
  close FILE;
  die "$filename is empty\n" if ($#line < 0);

  my $ref = eval "\\&$fn";
  my $msg = &$ref(\@line, @_, $filename);
  return 0 if (!defined($msg));
  die "$fn(\"$filename\"): $msg\n";
}

#
# check
#
sub check($;$)
{
  my $name = shift;
  my $value = shift;

  my $actual = $ENTITY{$name};
  die "!defined(\$ENTITY{\'$name\'})" if (!defined($actual));

  return $actual if (!defined($value) || $actual == $value);
  die "\$ENTITY{$name} == $actual, not $value\n";
}

#
# check_eq
#
sub check_eq($;$)
{
  my $name = shift;
  my $value = shift;

  my $actual = $ENTITY{$name};
  die "!defined(\$ENTITY{\'$name\'})" if (!defined($actual));

  return $actual if (!defined($value) || $actual eq $value);
  die "\$ENTITY{$name} == $actual, not $value\n";
}

#
# set_num
#
sub set_num($$)
{
  my $base = shift;
  my $num = shift;

  return if ($num < 0);
  $ENTITY{$base . '.D'} = $num;
  $ENTITY{$base . '.X'} = sprintf('0x%x', $num);
}

#
# set_num_diff
#
sub set_num_diff($$$)
{
  set_num shift, check(shift) - check(shift);
}

#
# credits
#
sub credits($;$)
{
  my $credits = shift;

  my $line = join(', ', sort(@$credits));
  $line =~ s/\s*\n//g;
  $ENTITY{'credits'} = $line;

  return undef;
}

#
# od_entry_point
#
sub od_entry_point($;$)
{
  my $line = shift;
  my $base = shift;

  return "\$#\$line == $#$line" if ($#$line != 0);
  my @number = split(/ /, $$line[0]);
  return "\$#number == $#number" if ($#number != 1);
  my $start = hex($number[1]);

  ($start == 0x08048080) || return "\$start == $start";
  set_num $base . '.start', $start;

  my $ofs = $start - $BASE_ADDR;
  ($ofs == 0x80) || return "\$ofs == $ofs";
  set_num $base . '.ofs', $ofs;

  return undef;
}

#
# ls
#
sub ls($$)
{
  my $line = shift;
  my $base = shift;

  return "\$#\$line == $#$line" if ($#$line < 0);
  return "Expected -rw" if (!($$line[0] =~ m/^-rw/));
  my @number = split(/ +/, $$line[0]);
  return "\$#number == $#number" if ($#number < 4);
  set_num $base . '.size', $number[4];
  return undef;
}

#
# ndisasm
#
sub ndisasm($$)
{
  my $line = shift;
  my $base = shift;

  my $nr_dword = 0;
  for $_(@$line)
  {
    my @number = split;
    if (m/\bpush dword 0x/)
    {
      return "\$#number == $#number" if ($#number != 4);
      set_num $base . '.ndisasm.dword' . $nr_dword++, hex($number[4]);
    }
    elsif (m/\bcall\b/)
    {
      return "\$#number == $#number" if ($#number != 3);
      set_num $base . '.ndisasm.call.addr', hex($number[3]);
      return undef;
    }
  }
  return "call expected";
}

#
# gdb_disasm
#
sub gdb_disasm($$)
{
  my $line = shift;
  my $base = shift;

  my $nr_dword = 0;
  my $nr_call = 0;
  for $_(@$line)
  {
    my @word = split;
    if (m/\bpush\s+0x/)
    {
      return "\$#word == $#word" if ($#word != 3);
      set_num $base . '.gdb.dword' . $nr_dword++, hex($word[3]);
    }
    elsif (m/\bcall\b/)
    {
      return "\$#word == $#word" if ($#word != 4);
      my $prefix = $base . '.gdb.call' . $nr_call++;
      set_num $prefix . '.addr', hex($word[3]);
      my $name = $word[4];
      $name =~ s/[<>]//g;
      $ENTITY{$prefix . '.name'} = $name;
    }
  }
  return undef;
}

#
# gdb_stack
#
sub gdb_stack($$)
{
  my $line = shift;
  my $base = shift;
  my $frame;
  for $_(@$line)
  {
    if (s/^\(gdb\)\s+#// || s/^#//)
    {
      my @word = split;
      $frame = $base . '.gdb.stack' . $word[0];
      my $prefix = $frame . '.ret';
      set_num $prefix, hex($word[1]);
      $ENTITY{$prefix} = $word[3];
    }
    elsif (s/^\s*at\s+//)
    {
      my @word = split /:/;

      my $prefix = $frame . '.source';
      set_num $prefix, $word[1];
      $ENTITY{$prefix} = $word[0];
    }
  }
  return undef;
}

#
# one_readelf_segment
# 
sub one_readelf_segment($$$$)
{
  my $filename = shift;
  my $base = shift;
  my $segment_name = shift;
  my $nr_load = shift;


  my @number = split / +/;
  return "\$#number == $#number" if ($#number < 5);

  my $virtaddr = hex($number[3]);
  my $filesiz = hex($number[5]);
  my $end = $virtaddr + $filesiz;

  # flags may contain spaces, e.g. "R E"
  # this will confuse the hell out of split(), so we use substr instead
  my $align = hex(substr($_, 68));
  if ($segment_name eq 'LOAD')
  {
    ($align == 4096) || die "$align != 4096 ($filename)";
  }

  # 'evil.magic.ofs.D' is set by parse_od()
  my $ofs = $ENTITY{$base . '.ofs.D'};
  if (defined($ofs))
  {
    my $codesize = $filesiz - $ofs;
    set_num $base . '.codesize', $codesize;

    my $bloat = int($codesize) / check($base . '.size.D');
    $ENTITY{$base . '.bloat'} = sprintf("%.3f", $bloat);
    $ENTITY{$base . '.bloat.percent'} = sprintf("%.0f", $bloat * 100);
  }
  my $prev_base = $base . '.' . $segment_name . ($nr_load - 1);
  my $prev_end = $ENTITY{$prev_base . '.end.D'};
  $base .=  '.' . $segment_name . $nr_load;

  if (defined($prev_end))
  {
    my $diff = $virtaddr - $prev_end;
    set_num($base . '.diff', $diff);

    my $diff_align = $diff - $align;
    if ($diff_align < 0)
    {
      print "<!-- $diff_align &lt; 0 ($filename) -->\n";
    }
    else
    {
      set_num($base . '.diff.align', $diff_align);
    }
  }
  elsif ($nr_load == 1 && $segment_name eq 'LOAD')
  {
    ($virtaddr == $BASE_ADDR) || die "$virtaddr != $BASE_ADDR ($filename)";
  }
  set_num($base . '.offset', hex($number[2]));
  set_num($base . '.virtaddr', $virtaddr);
  set_num($base . '.filesiz', $filesiz);
  set_num($base . '.end', $end);
  set_num($base . '.align', $align);

  return undef;
}

#
# readelf_segments
#   
sub readelf_segments($$)
{
  my $line = shift;
  my $base = shift;
  my $filename = shift;

  my $nr_load = 1;
  my $entry_point;
  my $msg = ls($line, $base);
  die "ls(\"$filename\"): $msg\n" if defined($msg);

  for $_(@$line)
  {
    my @number = split / +/;
    if (m/^Entry point /)
    {
      $entry_point = hex($number[2]);
      set_num $base . '.entry.point', $entry_point;
      set_num $base . '.entry.point.start.ofs', $entry_point - $BASE_ADDR;
    }
    elsif (m/^\s*LOAD\s*/)
    {
      my $msg = one_readelf_segment $filename, $base, 'LOAD', $nr_load;
      die "one_readelf_segment(\"$filename\"): $msg\n" if defined($msg);
      if ($nr_load++ == 1)
      {
        my $name = $base . '.LOAD1.end.D';
        my $end = $ENTITY{$name};
        return "undefined $name" if (!defined($end));
        set_num $base . '.entry.point.dist.to.end', $end - $entry_point;
      }
    }
    elsif (m/^\s*DYNAMIC\s*/)
    {
      my $msg = one_readelf_segment $filename, $base, 'DYNAMIC', 1;
      die "one_readelf_segment(\"$filename\"): $msg\n" if defined($msg);
    }
    elsif (m/^\s*NOTE\s*/)
    {
      my $msg = one_readelf_segment $filename, $base, 'NOTE', 1;
      die "one_readelf_segment(\"$filename\"): $msg\n" if defined($msg);
    }
  }
  return undef;
}

#
# readelf_sections
# 
sub readelf_sections($$)
{ 
  my $line = shift;
  my $base = shift;
    
  for $_(@$line)
  {
    if (m/^\s*\[[ 0-9]+\] \.text /)
    {
      my @word = split;
      set_num $base . '.text.addr', hex($word[3]);
      set_num $base . '.text.off', hex($word[4]);
      set_num $base . '.text.size', hex($word[5]);
      return undef;
    }
  }
  return "Expected section .text";
} 

#
# main
#
$ENTITY{'base.addr'} = sprintf('0x%x', $BASE_ADDR);

parse_file 'credits', 'CREDITS';
parse_file 'od_entry_point', 'out/i386/evil_magic/od', 'evil.magic';
parse_file 'readelf_segments', 'out/i386/readelf/segments', 'sh';
parse_file 'readelf_segments', 'out/i386/readelf/evil_magic', 'evil.magic';
parse_file 'readelf_segments', 'out/i386/entry_point/segments', 'infone';
parse_file 'readelf_segments', 'out/i386/additional_cs/segments', 'additional.cs';
parse_file 'ls', 'ls -l tmp/one_step_closer/infection |', 'infection';
parse_file 'gdb_disasm', 'out/i386/entry_point/sh.gdb', 'sh';
parse_file 'ndisasm', 'out/i386/entry_point/sh.ndisasm', 'sh';
parse_file 'ndisasm', 'out/i386/entry_point/two.ndisasm', 'inftwo';
parse_file 'ndisasm', 'out/i386/entry_point/three.ndisasm', 'infthree';
parse_file 'readelf_sections', 'out/i386/entry_point/sections', 'sh';
parse_file 'gdb_stack', 'out/i386/stub_revisited/stack', 'evil.magic';

check 'evil.magic.LOAD1.filesiz.D', 0x97;
check 'sh.entry.point.D', check('sh.text.addr.D');
check_eq 'sh.gdb.call0.name', '__libc_start_main';

set_num_diff 'infone.size.delta',
  'infone.size.D', 'sh.size.D';
set_num_diff 'infone.LOAD1.filesiz.delta',
  'infone.LOAD1.filesiz.D', 'sh.LOAD1.filesiz.D';
set_num_diff 'infone.LOAD2.offset.delta',
  'infone.LOAD2.offset.D', 'sh.LOAD2.offset.D';
set_num_diff 'infone.DYNAMIC1.offset.delta',
  'infone.DYNAMIC1.offset.D', 'sh.DYNAMIC1.offset.D';
set_num_diff 'additional.cs.size.delta',
  'additional.cs.size.D', 'sh.size.D';

open(SGML, '>', $::sgml) || die "$!";
open(SH, '>', $::sh) || die "$!";
for my $name(keys(%ENTITY))
{
  printf SGML "<!ENTITY calc.%s \"%s\">\n", $name, $ENTITY{$name};
  my $sh_name = $name;
  $sh_name =~ s/\./_/g;
  printf SH "%s=\'%s\'\n", $sh_name, $ENTITY{$name};
}
close SH;
close SGML;
