#!/usr/bin/perl -Ietc -w
use strict;
use Entity qw( %ENTITY check_eq );

use Segment();
use SystemName();
use PackageTool qw( add_which );

my $XML_ENTITY_PRE = 'xml.';
my $SYS_ENTITY_FMT = "<!ENTITY %s SYSTEM \"%s\">\n";
my $HOSTNAME = Entity::get_env('HOSTNAME');

#
# get_header
#
sub get_header()
{
}

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

  my $elfbase;
  for(my $i = 0; $i < $#$line; $i++)
  {
    $_ = $$line[$i];
    if (m/^\s*LOAD\s+/)
    {
      my $segment = Segment->new();
      my $msg = $segment->from_readelf($_, $$line[++$i]);
      return $msg if (defined($msg));

      check_eq 'ELF_BASE', $segment->{VirtAddr};
      check_eq 'ELF_ALIGN', $segment->{Align};
      check_eq 'ELF_ADDR_SIZE', $segment->{AddrSize};

      # assume first LOAD segment is code
      return undef;
    }
  }
  return 'returned no result.';
}

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

  for(my $i = 0; $i < $#$line; $i++)
  {
    $_ = $$line[$i];
    if (m/\s+file format elf([36][24])-/)
    {
      $ENTITY{'ELF_ADDR_SIZE'} = $1;
      for my $c('E', 'P', 'S')
      {
	$ENTITY{'ELF_' . $c . 'HDR'} = 'Elf' . $1 . '_' . $c . 'hdr';
      }
      next;
    }
    if (m/^\s*LOAD\s+/)
    {
      my $segment = Segment->new();
      my $msg = $segment->from_objdump($_, $$line[++$i]);
      return $msg if (defined($msg));

      my $arch = $ENTITY{'ARCH'} || die;
      $msg = $segment->check_platform($arch);
      return $msg if (defined($msg));

      $ENTITY{'PAGESIZE'} = Segment::page_size($arch);
      $ENTITY{'BYTE_ORDER'} = Segment::byte_order($arch);

      $ENTITY{'ELF_BASE'} = $segment->{VirtAddr} || die;
      $ENTITY{'ELF_ALIGN'} = $segment->{Align} || die;

      my $elfmagic = $segment->{VirtAddr};
      return "Last digit of ELF base address ($elfmagic) is not zero"
      unless ($elfmagic =~ s/0$/1/);
      $ENTITY{'ELF_MAGIC'} = $elfmagic;

      # assume first LOAD segment is code
      return undef;
    }
  }
  return 'returned no result.';
}

#
# get_elf_base
#
sub get_elf_base()
{
  my $objdump = add_which(1, 'OBJDUMP', 'objdump', 'gobjdump');
  Entity::parse_file 'objdump_segments', "$objdump -p /bin/sh |";

  my $readelf = add_which(0, 'READELF', 'readelf', 'greadelf');
  if (defined($readelf))
  {
    Entity::parse_file 'readelf_segments', "$readelf -l /bin/sh |";
  }
}

#
# xml_file_by_var
#
sub xml_file_by_var($$@)
{
  my $output = shift;
  my $key = shift;

  for my $name(@_)
  {
    my $file = 'platform/' . $name . '/' . $key . '.xml';
    my $entity = $XML_ENTITY_PRE . $name; 
    $entity =~ y#-/_#.#;

    if ( -e $file )
    {
      printf $output $SYS_ENTITY_FMT, $entity, $file;
      next;
    }
    my $default = 'platform/' . $name . '/default.xml';
    if ( -e $default )
    {
      printf $output $SYS_ENTITY_FMT, $entity, $default;
      next;
    }
    printf $output "<!-- %s -->\n", $file;
    printf $output "<!ENTITY %s \"\">\n", $entity;
  }
}

#
# xml_file_by_have_var
#
sub xml_file_by_have_var($$@)
{
  my $output = shift;
  my $variable = shift;

  my $key = defined($PackageTool::PATH{uc($variable)})
  ? $variable : 'default';
  for my $name(@_)
  {
    my $file = 'platform/' . $name . '/' . $key . '.xml';
    my $entity = $XML_ENTITY_PRE . $name . '.' . $variable;
    $entity =~ y#-/_#.#;

    if ( -e $file )
    {
      printf $output $SYS_ENTITY_FMT, $entity, $file;
      next;
    }
    printf $output "<!-- %s -->\n", $file;
    printf $output "<!ENTITY %s \"\">\n", $entity;
  }
}

#
# write_XML_header
#
sub write_XML_header($)
{
  my $output = shift;

  my $uname = $ENTITY{'UNAME'};
  my $arch = $ENTITY{'ARCH'};
  my $a_u = $arch . '-' . $uname;
  my $pkg_sys = $ENTITY{'OS_PKG_SYS'};

  xml_file_by_var $output, $pkg_sys,
    'packages/finding.owner',
    'packages/verify'
    ;
  xml_file_by_var $output, $arch,
    'magic.revealed/syscall/platform'
    ;
  xml_file_by_var $output, $uname,
    'os.download',
    'magic.of.elf/other.magic',
    'magic.revealed/syscall/man'
    ;
  xml_file_by_var $output, $a_u,
    'magic.revealed/syscall/asm',
    'language.of.evil/hand.crafted'
    ;
  xml_file_by_var $output, $arch,
    'language.of.evil/infection',
    ;

  xml_file_by_have_var $output, 'hexdump',
    'magic.of.elf';
  xml_file_by_have_var $output, 'ndisasm',
    'magic.revealed',
    'language.of.evil'
    ;
  xml_file_by_have_var $output, 'readelf',
    'readelf/evil.magic/segments',
    'readelf/evil.magic/sections',
    'readelf/sh/segments',
    'readelf/sh/sections',
    'segment.padding',
    'additional.cs'
    ;
  xml_file_by_have_var $output, 'elfdump',
    'readelf/evil.magic/segments',
    'readelf/evil.magic/sections'
    ;
  xml_file_by_have_var $output, 'xxd',
    'magic.of.elf'
    ;

  my $out_xml = $ENTITY{'OUT_XML'};

  for my $name( 'calc', 'ulink' )
  {
    printf $output "<!ENTITY %% xml.%s SYSTEM \"%s/%s.xml\">\n",
       $name, $out_xml, $name;
  }

  my $website = $ENTITY{'OS_VENDOR'};
  $website = lc($ENTITY{'UNAME'}) if (!defined($website));

  printf $output
    "<!ENTITY config.OS.NOTE \"&note.%s;\">\n",
    $website;
  printf $output
    "<!ENTITY config.OS.DOWNLOAD.NOTE \"&note.%s.download;\">\n",
    $website;

  my $versions = $out_xml . '/versions.xml';
  printf $output $SYS_ENTITY_FMT, 'xml.versions', $versions;
  Entity::open_xml_file(*FILE, $versions);
  PackageTool::write_xml_versions(*FILE);
  close FILE;

  my $path = $out_xml . '/path.xml';
  printf $output $SYS_ENTITY_FMT, 'xml.path', $path;
  Entity::open_xml_file(*FILE, $path);
  Entity::write_xml_table(*FILE, \%PackageTool::PATH);
  close FILE;
  
  my $variables = $out_xml . '/variables.xml';
  printf $output $SYS_ENTITY_FMT, 'xml.variables', $variables;
  Entity::open_xml_file(*FILE, $variables);
  Entity::write_xml_table(*FILE, \%ENTITY, undef, 'PWD', 'DIRNAME');
  close FILE;

  my $elf_defaults = $out_xml . '/elf_defaults.xml';
  printf $output $SYS_ENTITY_FMT, 'xml.elf.defaults', $elf_defaults;
  Entity::open_xml_file(*FILE, $elf_defaults);
  Segment::write_xml_elf_defaults(*FILE);
  close FILE;
}

#
# write_MAK_HEADER
#
sub write_MAK_HEADER($$$$);
sub write_MAK_HEADER($$$$)
{
  my $MAK = shift;
  my $dir = shift;
  my $src_pre = shift;
  my $dst_pre = shift;

  opendir(DIR, $dir) || die "opendir $dir failed: $!";
  my @entry = readdir(DIR);
  closedir DIR;

  print $MAK "SED_TEVWH = \$(TEVWH_PATH_SED) -f config-\$(HOSTNAME).sed\n";
  for my $entry(@entry)
  {
    next if ($entry =~ m/^\./);
    my $full = $dir . '/' . $entry;
    stat($full);
    if ( -d _ )
    {
      write_MAK_HEADER(
        $MAK, $full, $src_pre . $entry . '/', $dst_pre . $entry . '/'
      );
    }
    else
    {
      printf $MAK "%s%s: %s%s\n\t\$(SED_TEVWH) \$? > \$@%s",
	$dst_pre, $entry, $src_pre, $entry,
	(( -x _ ) ? " && chmod 755 \$@\n" : "\n")
	;
    }
  }
}  

#
# write_output
#
sub write_output()
{
  Entity::open_config_file(*SH, 'config-' . $HOSTNAME . '.sh');
  Entity::open_config_file(*CSH, 'config-' . $HOSTNAME . '.csh');
  Entity::open_config_file(*MAK, 'config-' . $HOSTNAME . '.mak');
  Entity::open_config_file(*SED, 'config-' . $HOSTNAME . '.sed');

  printf SED "1 {\n";
  for my $name('sh', 'sed', 'perl')
  {
    printf SED "\ts@^#!/.*/%s\\>@#!%s@\n",
      $name, $PackageTool::PATH{uc($name)};
  }
  printf SED "}\n";

  printf SED "s#^src/#%s/#\n", $ENTITY{'PRE'};
  printf SED "s#\\([^/]\\)src/#\\1%s/#g\n", $ENTITY{'PRE'};

  Entity::open_config_file(*H, $ENTITY{'OUT'} . '/config.h', '/* ', ' */');
  Entity::open_xml_file(*XML, 'config-' . $HOSTNAME . '.xml');

  write_XML_header *XML;
  Entity::write_sh_variables
    \%ENTITY, *SH, *CSH, *MAK, *SED, *H, *XML;
  Entity::write_sh_variables
    \%PackageTool::PATH, *SH, *CSH, *MAK, *SED, *H, *XML, 'PATH_';
  Entity::write_sh_variables
    \%PackageTool::MANPAGES, *SH, *CSH, *MAK, *SED, *H, *XML, 'MAN_';

  my %NAME;
  for my $key('SH', 'CSH')
  {
    my $value = $PackageTool::PATH{$key};
    die "\$PATH{$key} is undefined." if (!defined($value));
    $value =~ m#/([^/]+)$# || die "\$ENTITY{$key} is broken.";
    $NAME{$key} = $1;
  }
  Entity::write_sh_variables
    \%NAME, *SH, *CSH, *MAK, *SED, *H, *XML, 'NAME_';

  write_MAK_HEADER *MAK, 'src', 'src/', '$(TEVWH_PRE)/';

  close SH;
  close CSH;
  close MAK;
  close SED;
  close H;
  close XML;
}

#
# MAIN
#
print "get_header...\n";
my $cwd = POSIX::getcwd();
$ENTITY{'PWD'} = $cwd;
my $dirname = $cwd;
$dirname =~ s#.*/##;
$ENTITY{'DIRNAME'} = $dirname;

print "SystemName::determine...\n";
SystemName::determine;

print "get_elf_base...\n";
get_elf_base;

print "add_which...\n";

add_which(1, 'CC', 'gcc', 'cc', 'c89');
add_which(1, 'CSH', 'tcsh', 'csh');

for my $tool(
  'bc', 'chmod', 'col', 'cut', 'dd', 'du', 'echo', 'expand',
  'find', 'file', 'gdb', 'grep', 'head', 'head', 'kill', 'ld', 'ldd',
  'ls', 'make', 'mt', 'man', 'nm', 'nice', 'od', 'perl', 'sed', 'sh',
  'sort', 'strings', 'strip', 'tail', 'tee', 'tr', 'uniq', 'which', 'xargs'
)
{ add_which(1, $tool); }

if ($ENTITY{'ARCH'} eq 'i386')
{
  add_which(1, 'nasm');
  add_which(1, 'ndisasm');
}
if ($ENTITY{'UNAME'} eq 'SunOS')
{
  add_which(0, 'dump');
  add_which(0, 'elfdump');
}

add_which(0, 'hexdump');
add_which(0, 'strace');
add_which(0, 'truss');
add_which(0, 'xxd');

for my $file('/usr/include/unistd.h', '/usr/include/elf.h')
{
  die "Can't find $file" if (!defined(PackageTool::add_path($file, 1)));
}

my $dir = $ENTITY{'OS_CODE'};
$ENTITY{'TMP'} = "tmp/$dir";
$ENTITY{'PRE'} = "pre/$dir";


mkdir "out", 0777;
mkdir $ENTITY{'OUT'} = "out/$dir", 0777;
mkdir $ENTITY{'OUT_XML'} = "out/$dir/xml", 0777;

$ENTITY{'CFLAGS'} = "-O1 -I out/$dir -D NDEBUG";

print "PackageTool::determine...\n";
PackageTool::determine 'ls', 'fork', 'printf', 'syscall';

print "write_output...\n";
write_output;
