#!/usr/bin/perl -Isrc -w
use strict;
use readelf_segment;

my $ENTITY_PREFIX = 'config.';
my $GENERATED = 'Generated by configure.pl, do not edit.';

my @DIST_REDHAT = ( 'redhat', '/etc/redhat-release', 'rpm' );
my @DIST_DEBIAN = ( 'debian', '/etc/debian_version', 'dpkg' );
my @DIST_SUSE = ( 'suse', '/etc/SuSE-release', 'rpm' );
my @DIST_FILE = ( \@DIST_REDHAT, \@DIST_DEBIAN, \@DIST_SUSE );

my %PROC_EXE = (
  'Linux' => '/proc/self/exe',
  'FreeBSD' => '/proc/curproc/file',
  'SunOS' => '/proc/self/object/a.out'
);

# package names that are called the same on redhat, suse and debian
my @PACKAGE = (
  'bash', 'bc', 'binutils', 'file', 'gcc', 'gdb', 'make', 'perl',
);
my @PACKAGE_i386 = ( 'nasm' );

my @PACKAGE_REDHAT = (
  'gcc-c++', 'findutils', 'glibc', 'man-pages', 'util-linux'
);

# SuSE changed some package names between 6.0 and 7.3, try all
my @PACKAGE_SUSE = (
  'egcs', 'find', 'findutils', 'glibc', 'gpp', 'man-pages', 'util',
  'util-linux'
);
my @PACKAGE_DEBIAN = (
  'findutils', 'g++', 'bsdmainutils', 'libc6', 'manpages', 'manpages-dev'
);

my %ENTITY;

#
# findFile
#
# sub findFile($@)
# {
#   my $file = shift;
#   for my $dir(@_)
#   {
#     my $result = $dir . '/' . $file;
#     if (-f $result)
#     {
#       $file =~ y/./_/;
#       $ENTITY{uc($file)} = $result;
#       return $result;
#     }
#   }
#   return undef;
# }

#
# getDistributionName
#
sub getDistributionName()
{
  for my $dist(@DIST_FILE)
  {
    my $line = readFirstLine($$dist[1]);
    next if (!defined($line));
    
    my $vendor = $$dist[0];
    $ENTITY{'OS_VENDOR'} = $vendor;

    my $func = \&{'cfg_' . $vendor};
    my ( $version, $full ) = &$func($line);

    $ENTITY{'PKGTOOL'} = $$dist[2];
    $ENTITY{'OS_VERSION'} = $version;
    $ENTITY{'OS_NAME'} = $full;

    my $code = lc(sprintf('%s-%s-%s',
      $ENTITY{'ARCH'}, $vendor, $ENTITY{'UNAME'}));
    $ENTITY{'OS_CODE'} = $code;

    return;
  }
}

#
# getUNAME
#
sub getUNAME()
{
  my $uname = `uname`;
  chomp $uname;
  $ENTITY{'UNAME'} = $uname;
  $ENTITY{'PROC_EXE'} = $PROC_EXE{$uname};

  my $cflags = '-Wall -O2';

  # SunOS will return 'sparc' for -p, and something like 'sun4u' for -m.
  # OTOH Linux distributions return 'unknown' for -p
  my $arch = `uname -p`;
  chomp $arch;
  if ($arch eq 'unknown')
  {
    $arch = `uname -m`;
    chomp $arch;
  }

  $ENTITY{'ASM_STYLE'} = 'att';
  if ($arch eq 'alpha')
  {
    $cflags = '-Wall -O1';
  }
  elsif ($arch ne 'sparc' && $arch ne 'ppc' && $arch ne 'sparc64')
  {
    $arch = 'i386';
    $cflags .= ' -march=i586';
    $ENTITY{'ASM_STYLE'} = 'intel';
  }
  $ENTITY{'ARCH'} = $arch;
  $ENTITY{'CFLAGS'} = $cflags;
  $ENTITY{'HOSTTYPE'} = "$uname/$arch";

  if ($uname eq 'Linux')
  {
    getDistributionName;
    return;
  }
  my $release = `uname -r`;
  chomp $release;
  $ENTITY{'OS_VERSION'} = $release;
  $ENTITY{'OS_NAME'} = "$uname $release";
  $ENTITY{'OS_CODE'} = lc("$uname-$arch");
}

sub readFirstLine($)
{
  my $filename = shift;
  ( -e $filename ) || return undef;
  open(FILE, '<' . $filename) || die "Can't open $filename: $!";
  my $file = <FILE>;
  $file =~ s/\s+$//;
  close FILE;
  return $file;
}

sub setVersion(@_)
{
  $ENTITY{"PKG_VERSIONS"} =
    '<member>' .
    join('</member><member>', sort(@_)) .
    '</member>'
    ;
}

sub version_rpm(@)
{
  open(CMD, "rpm -q @_ |") || die "'rpm -q' failed: $!";
  my @line;
  while(<CMD>)
  {
    chomp;
    push @line, $_;
  }
  close CMD;
  setVersion(@line);
}

sub cfg_redhat($)
{
  my $line = shift;
  $line =~ m/([0-9]+\.[0-9])/;

  my @query = @PACKAGE;
  push(@query, @PACKAGE_REDHAT);
  push(@query, @PACKAGE_i386) if ($ENTITY{'ARCH'} eq 'i386');
  version_rpm @query;

  return ( $1, $line );
}

sub cfg_suse($)
{
  my $line = shift;
  $line =~ m/([0-9]+\.[0-9])/;

  my @query = @PACKAGE;
  push(@query, @PACKAGE_SUSE);
  push(@query, @PACKAGE_i386) if ($ENTITY{'ARCH'} eq 'i386');
  version_rpm @query;

  return ( $1, $line );
}

sub version_dpkg(@)
{
  open(CMD, "dpkg --print-avail @_ |")
  || die "'dpkg --print-avail -q' failed: $!";
  my @line;
  my $name;
  while(<CMD>)
  {
    chomp;
    if (s/^Package:\s+//) { $name = $_; }
    elsif (s/^Version:\s+//) { push @line, "$name-$_"; } 
  }
  close CMD;
  setVersion(@line);
}

sub cfg_debian($)
{
  my $line = shift;
  my $full = sprintf('Debian GNU/Linux %s', $line);

  my @query = @PACKAGE;
  push(@query, @PACKAGE_DEBIAN);
  push(@query, @PACKAGE_i386) if ($ENTITY{'ARCH'} eq 'i386');
  version_dpkg @query;

  return ( $line , $full );
}

sub which(@)
{
  for my $name(@_)
  {
    my $path = `which $name`;
    chomp $path;

    # if first character is not a slash, then it is an error message,
    # not an absolute path
    return $path if (substr($path, 0, 1) eq '/');
  }
  die "Unsuccesfully searched PATH for one of " . join(', ', @_);
}

sub getELF_BASE()
{
  my $readelf = which('readelf', 'greadelf');
  $ENTITY{'READELF'} = $readelf;
  my $elfbase;
  my $cmd = "$readelf -l /bin/sh";
  open(CMD, $cmd . '|') || die "$cmd: $!";
  while(<CMD>)
  {
    if (m/^\s*LOAD\s+/)
    {
      chomp;
      my $nl = <CMD> || die;
      chomp $nl;

      my ( $offset, $filesiz, $align, $addrsize );
      ( $offset, $elfbase, $filesiz, $align, $addrsize )
      = readelf_segment::one($_, $nl);
      die "Broken output from $cmd\n" if (!defined($offset));

      $ENTITY{'ELF_BASE'} = $elfbase;
      $ENTITY{'ELF_ALIGN'} = $align;
      $ENTITY{'ELF_ADDRSIZE'} = $addrsize;
      last;
    }
  }
  close CMD;
  die $cmd . ' returned no result.' if (!defined($elfbase));

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

}

sub checkDocFile($$@)
{
  my $output = shift;
  my $postfix = shift;

  for my $name(@_)
  {
    my $file = "platform/$name/$postfix.xml";
    my $entity = sprintf("xml.%s", $name);
    $entity =~ y#-/_#.#;

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

sub writeOutput()
{
  open(XML, '> config.xml') || die "$!";
  printf XML "<!-- $GENERATED -->\n\n";

  my $uname = $ENTITY{'UNAME'};
  my $arch = $ENTITY{'ARCH'};
  checkDocFile *XML, $uname, 'magic.of.elf/hexdump';
  checkDocFile *XML, $uname, 'magic.of.elf/other.magic';
  checkDocFile *XML, "$arch-$uname", 'language.of.evil/ndisasm';
  checkDocFile *XML, "$arch-$uname", 'language.of.evil/static.gdb';
  checkDocFile *XML, "$arch-$uname", 'language.of.evil/syscall';
  checkDocFile *XML, "$arch-$uname", 'language.of.evil/hand.crafted';

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

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

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

  open(MAK, '> config.mak') || die "$!";
  print MAK "# $GENERATED\n\n";
  open(CSH, '> config.csh') || die "$!";
  print CSH "# $GENERATED\n\n";
  open(SH, '> config.sh') || die "$!";
  print SH "# $GENERATED\n\n";
  for my $name(keys(%ENTITY))
  {
    my $entity = $name;
    $entity =~ y#-/_#.#;
    printf XML "<!ENTITY %s%s \"%s\">\n",
      $ENTITY_PREFIX, $entity, $ENTITY{$name};

    printf MAK "%s=%s\n", $name, $ENTITY{$name};
    printf CSH "setenv %s '%s'\n", $name, $ENTITY{$name};
    printf SH "%s='%s'\n", $name, $ENTITY{$name};
  }
  close SH;
  close CSH;
  close MAK;
  close XML;
}

#
# MAIN
#
getUNAME;
getELF_BASE;
$ENTITY{'OBJDUMP'} = which('objdump', 'gobjdump'); 

my $dir = $ENTITY{'OS_CODE'};
$ENTITY{'TMP'} = "tmp/$dir";
$ENTITY{'OUT'} = "out/$dir";
$ENTITY{'OUT_XML'} = "out/$dir/xml";

writeOutput;
