#!/usr/bin/perl -w

use strict;
use Cwd;

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_FILE = ( \@DIST_REDHAT, \@DIST_DEBIAN );

# package names that are called the same on redhat and debian
my @PACKAGE = (
  'bash', 'bc', 'binutils', 'file', 'findutils', 'gcc', 'gcc-c++',
  'glibc', 'gdb', 'make', 'perl', 'util-linux'
);

my %ENTITY;

sub getDirectory()
{
  my $pwd = getcwd;
  $ENTITY{'PWD'} = $pwd;
  my $dirname = $pwd;
  $dirname =~ s#.*/##;
  $ENTITY{'DIRNAME'} = $dirname;
  $ENTITY{'HTML'} = sprintf('file://%s/_html/index.html', $pwd);
  $ENTITY{'DVI'} = sprintf('file://%s/_dvi/%s.dvi', $pwd, $dirname);
}

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

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

  return $uname;
}

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 version_rpm(@)
{
  open(CMD, "rpm -q @_ |") || die "'rpm -q' failed: $!";
  my @line;
  while(<CMD>)
  {
    chomp;
    push @line, $_;
  }
  close CMD;
  $ENTITY{"PKG_VERSIONS"} = join(', ', sort(@line));
}

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

  my @query = @PACKAGE;
  push(@query, 'nasm') 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;
  $ENTITY{"PKG_VERSIONS"} = join(', ', sort(@line));
}

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

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

  return ( $line , $full );
}

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

    my $func = \&{$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',
      $vendor, $ENTITY{'UNAME'}, $ENTITY{'ARCH'}));
    $ENTITY{'OS_CODE'} = $code;

    return;
  }
}

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

      $elfbase = substr($number[2], 2);
      $ENTITY{'ELF_BASE'} = $elfbase;

      # flags may contain spaces, e.g. "R E"
      # this will confuse the hell out of split(),
      # so we use substr instead
      $ENTITY{'ELF_ALIGN'} = substr($_, 70);

      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 $entity = sprintf("%sxml.%s", $ENTITY_PREFIX, $name);
    my $file = "xml/$name/$postfix.xml";
    printf $output "<!ENTITY %s %s>\n", $entity,
      ( -e $file ) ? "SYSTEM \"$file\"" : '""';
  }
}

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

  checkDocFile *XML, $ENTITY{'UNAME'}, 'other.magic';

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

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

  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
#

getDirectory; 
my $uname = getUNAME;
getOSNAME;
getELF_BASE;

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

writeOutput;
