#!/usr/bin/perl -Ietc -w
use strict;
use Entity qw(
  %ENTITY
  $SYS_ENTITY_FMT
);
use Misc();
use Segment();
use SystemName();
use GetElfBase();
use PackageTool qw( add_which );

my $HOST = Misc::get_env('HOST');
my $LANG = $ENV{'LANG'};
die "Environment variable LANG is set to $LANG"
if (defined($LANG) && $LANG =~ m/utf/i);

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

  my $uname = $ENTITY{'UNAME'} || die "ENTITY{UNAME} is not defined";
  my $arch = $ENTITY{'ARCH'} || die "ENTITY{ARCH} is not defined";
  my $a_u = $arch . '-' . $uname;
  my $pkg_sys = $ENTITY{'OS_PKG_SYS'}
  || die "ENTITY{OS_PKG_SYS} is not defined";

  # only Linux distribution have vendors (FreeBSD is just FreeBSD)
  my $os_vendor = $ENTITY{'OS_VENDOR'};
  $os_vendor = lc($uname) if (!defined($os_vendor));

  Entity::xml_file_by_var $output, $pkg_sys,
    'packages/finding.owner',
    'packages/verify',
    'packages/nopkg',
    ;
  Entity::xml_file_by_var $output, $arch,
    'magic.revealed/syscall/platform'
    ;
  Entity::xml_file_by_var $output, $uname,
    'packages/os/uname',
    'magic.of.elf/other.magic',
    'magic.revealed/syscall/man',
    'additional.cs/find.ok'
    ;
  Entity::xml_file_by_var $output, $a_u,
    'magic.revealed/syscall/asm',
    'language.of.evil/hand.crafted'
    ;
  Entity::xml_file_by_var $output, $arch,
    'language.of.evil/infection',
    ;

  Entity::xml_file_by_have_path $output, 'hexdump',
    'magic.of.elf',
    'additional.cs/note'
    ;
  Entity::xml_file_by_have_path $output, 'ndisasm',
    'magic.revealed',
    'language.of.evil'
    ;
  Entity::xml_file_by_have_path $output, 'readelf',
    'segments',
    'sections',
    'segments/sh',
    'sections/sh',
    'segment.padding',
    'additional.cs',
    'additional.cs/note'
    ;
  Entity::xml_file_by_have_path $output, 'elfdump',
    'segments',
    'sections'
    ;
  Entity::xml_file_by_have_path $output, 'xxd',
    'magic.of.elf',
    'additional.cs/note'
    ;
  Entity::xml_file_by_have_path $output, 'distid',
    'packages'
    ;
  Entity::xml_file_by_have_path $output, 'isainfo',
    'packages'
    ;
  Entity::xml_file_by_have_path $output, 'isalist',
    'packages'
    ;
  for my $file('usr_bin_perl', 'bin_bash')
  {
    Entity::xml_file_by_have_nopkg $output, $file,
      'packages/nopkg/' . $pkg_sys
    ;
  }

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

  Entity::xml_file_by_var $output, $ENTITY{'OS_CODE'},
    'packages/os/code',
    ;
  Entity::xml_file_by_var $output, $os_vendor,
    'packages/os/vendor',
    ;

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

  my $versions = $out_xml . '/versions.xml';
  printf $output $SYS_ENTITY_FMT, 'xml.versions', '../' . $versions;
  Misc::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;
  Misc::open_xml_file(*FILE, $path);
  Misc::write_xml_table(*FILE, \%PackageTool::PATH);
  close FILE;
  
  my $variables = $out_xml . '/variables.xml';
  printf $output $SYS_ENTITY_FMT, 'xml.variables', '../' . $variables;
  Misc::open_xml_file(*FILE, $variables);
  Misc::write_xml_table(*FILE, \%ENTITY, undef, undef, 'PWD', 'DIRNAME');
  close FILE;

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

#
# write_MAK_pre
#
sub write_MAK_pre($$$$);
sub write_MAK_pre($$$$)
{
  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;

  for my $entry(@entry)
  {
    next if ($entry =~ m/^\./);
    my $full = $dir . '/' . $entry;
    stat($full);
    if ( -d _ )
    {
      write_MAK_pre(
        $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_MAK_cc_deps
#
# naive approach to define #include dependencies
# does not need special compiler or pre-processor, though
#
sub write_MAK_cc_deps($$)
{
  my $MAK = shift;
  my $dir = shift;

  my $name = $dir . '_cc_deps';
  $name =~ s#/#_#g;
  $dir = 'src/' . $dir;

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

  print $MAK "$name =";
  for my $entry(@entry)
  {
    next if (!($entry =~ /\.(c|h|inc)$/));
    printf $MAK " \\\n\t%s/%s", $dir, $entry;
  }
  print $MAK "\n";
}

#
# write_MAK
#
sub write_MAK(*$$)
{
  my $MAK = shift;
  my $filename = 'etc/Makefile/' . shift();
  my $hash = shift;

  open(TEMP, '<' . $filename) || die "Can't open $filename: $!";
  while(<TEMP>)
  {
    next if (m/^\s*#/);
    while(my ($key, $value) = each(%$hash))
    {
      s/\$\{$key}/$value/eg;
    }
    print $MAK $_;
  }
  print $MAK "\n";
  close(TEMP);
}

#
# write_MAK_infection
#
sub write_MAK_infection($)
{
  my $MAK = shift;

  my %hash;
  for my $i('i1', 'i2', 'i3', 'i4')
  {
    $hash{INFECTION} = $i;
    write_MAK *MAK, 'infection', \%hash;
  }
}

#
# write_MAK_test_infection
#
sub write_MAK_test_infection($)
{
  my $MAK = shift;

  my %hash = ( 'INFECTION' => 'i1' );

  for my $project('segment_padding', 'additional_cs')
  {
    $hash{SCANNER} = $project;
    $hash{PROJECT} = $project;
    $hash{ENTRY} = 'e1';
    write_MAK *MAK, 'test-infection', \%hash;
    $hash{ENTRY} = 'e2';
    write_MAK *MAK, 'test-infection', \%hash;
    $hash{ENTRY} = 'e3';
    write_MAK *MAK, 'test-infection', \%hash;
  }

  $hash{SCANNER} = 'segment_padding';
  $hash{PROJECT} = 'doing_it_in_c';
  $hash{INFECTION} = 'i2';
  write_MAK *MAK, 'test-infection', \%hash;
  $hash{INFECTION} = 'i3';
  write_MAK *MAK, 'test-infection', \%hash;
  $hash{INFECTION} = 'i4';
  write_MAK *MAK, 'test-infection', \%hash;
}

#
# write_MAK_scanner
#
sub write_MAK_scanner($$$)
{
  my $MAK = shift;
  my $scanner = shift;
  my $type = shift;

  my %hash = (
    'SCANNER' => $scanner,
    'TYPE' => $type
  );
  my $all = "scanner_$scanner:";

  if ($type eq 'plain')
  {
    write_MAK_cc_deps *MAK, 'scanner/' . $scanner;
    write_MAK $MAK, 'scanner', \%hash;
    write_MAK $MAK, 'scanner_mkinfect', \%hash;
    $all .= " \\\n\tscanner_" . $scanner . "_mkinfect";
  }
  for my $set('big', 'small')
  {
    $hash{SET} = $set;
    for my $linked('static', 'dynamic')
    {
      $all .= " \\\n\t\$(TEVWH_OUT)/scanner/$scanner/$set.$linked";
      $hash{LINKED} = $linked;
      write_MAK $MAK, 'scanner_driver', \%hash;
    }
  }
  print $MAK $all . "\n\n";
}

#
# write_output
#
sub write_output()
{
  Misc::open_config_file(*SH, 'out/config-' . $HOST . '.sh');
  Misc::open_config_file(*CSH, 'out/config-' . $HOST . '.csh');
  Misc::open_config_file(*MAK, 'out/config-' . $HOST . '.mak');
  Misc::open_config_file(*SED, 'out/config-' . $HOST . '.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'};

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

  write_XML_header *XML;
  Misc::write_sh_variables
    \%ENTITY, *SH, *CSH, *MAK, *SED, *H, *XML;
  Misc::write_sh_variables
    \%PackageTool::PATH, *SH, *CSH, *MAK, *SED, *H, *XML, 'PATH_';
  Misc::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;
  }
  Misc::write_sh_variables
    \%NAME, *SH, *CSH, *MAK, *SED, *H, *XML, 'NAME_';

  print MAK "SED_TEVWH = \$(TEVWH_PATH_SED) -f out/config-\$(HOST).sed\n";
  write_MAK_pre *MAK, 'src', 'src/', '$(TEVWH_PRE)/';
  write_MAK_cc_deps *MAK, 'one_step_closer';
  write_MAK_cc_deps *MAK, 'segment_padding';
  write_MAK_cc_deps *MAK, 'additional_cs';
  write_MAK_cc_deps *MAK, 'doing_it_in_c';

  write_MAK_infection *MAK;
  write_MAK_test_infection *MAK;
  write_MAK_scanner *MAK, 'entry_point', 'objdump';
  write_MAK_scanner *MAK, 'filesize', 'plain';
  write_MAK_scanner *MAK, 'segment_padding', 'plain';
  write_MAK_scanner *MAK, 'additional_cs', 'plain';

  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";
GetElfBase::get_elf_base
  add_which(1, 'OBJDUMP', 'objdump', 'gobjdump'),
  add_which(0, 'READELF', 'readelf', 'greadelf')
  ;

print "add_which...\n";

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

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

if ($ENTITY{'ARCH'} eq 'i386')
{
  SystemName::dont_have_nasm  if (!add_which(0, 'nasm'));
  add_which(0, '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'} = "-W -Wall -Wno-unused -O1 -I out/$dir -D NDEBUG";
$ENTITY{'CFLAGS'} = "-Wall -O1 -I . -I out/$dir -D NDEBUG";

# _ASM is required for sys/syscall.h on Solaris 2.7
$ENTITY{'AFLAGS'} = "-I . -D _ASM";
$ENTITY{'ASM'} = sprintf '%s_%s_%s',
  $ENTITY{'ARCH'}, $ENTITY{'UNAME'}, $ENTITY{'ASM_STYLE'};

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

print "write_output $HOST $dir ...\n";
write_output;
