#!/usr/bin/perl -wT

# F*EX CGI for FIX Java client
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#
# Copyright: GNU General Public License

use Digest::MD5	qw(md5_hex);

# add fex lib
$FEXLIB =
  $0 =~ m:(/.+)/.+/: ? "$1/lib":
  $0 =~ m:(.*/):     ? "$1/../lib":
                       "../lib";
die "$0: no $FEXLIB\n" unless -d $FEXLIB;

$| = 1;

our $error = 'F*EX ERROR';
our $head = "$ENV{SERVER_NAME} F*EX FIX";

# import from fex.pp
our ($spooldir);

# load common code, local config: $FEXLIB/fex.ph
require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";

chdir $spooldir or http_die("$spooldir - $!\n");

my $akeydir = "$spooldir/.akeys"; # authentification keys
my $skeydir = "$spooldir/.skeys"; # authentification keys for subuser
my $ra = untaint($ENV{REMOTE_ADDR});
my ($name,$value);
my $user = '';
my $to = '';
my $id = '';
my $skey = '';
my $akey = '';

# parse HTTP QUERY_STRING
foreach (split '&',$ENV{QUERY_STRING}) {
  /(.+?)=(.*)/;
  $name  = $1 || $_;
  $value = $2 || '';
  # decode %URL-encoded parameters
  $value =~ s/%([a-f0-9]{2})/chr(hex($1))/gie;
  setparam($name,$value); 
};


if ($skey and $from and $to and $id) {
  if (open $to,'<',"$to/\@") {
    while (<$to>) {
      chomp;
      if (/^\Q$from:$id\E$/ or /^\*:$id\E$/) {
        $rid = $id;
        last;
      }
    }
    close $to;
  }
} elsif ($id and $from) {
  if (open $from,'<',"$from/\@") {
    $rid = <$from>;
    chomp $rid;
    close $from;
  }
} else {
  http_die("missing user data");
}

http_die("$from has no auth-ID") unless $rid;
http_die("Wrong auth-ID") if $rid ne $id;

http_header('200 OK');
print html_header($head);

if ($skey) {
  $id = "skey:$skey";
}

$java = 'http://java.sun.com/javase/downloads/index.jsp#jre';
pq(qq(
  '<applet code="fix.Client.class" archive="FIX.jar" width=150 height=50>'
  '  <param name="server"   value="$ENV{PROTO}://$ENV{HTTP_HOST}">'
  '  <param name="user"     value="$from">'
  '  <param name="to"       value="$to">'
  '  <param name="id"       value="$id">'
  '  <param name="skey"     value="$skey">'
  '  <param name="akey"     value="$akey">'
  '</applet>'
  '<script language="JavaScript"><!--'
  'if (navigator.javaEnabled()) {'
  '  /* JAVA ok */'
  '} else {'
  '  document.write("found no java runtime environment, cannot start F*IX upload applet");'
  '}'
  '//  --></script>'
  '<p>'
  '(you will need <a href="$java">java</a> version >= 1.6)'
  '<p>'
  '</body>'
  '</html>'
));

exit;


# set parameter variables
sub setparam {
  my ($v,$vv) = @_;
  my ($key,$idf);
  
  $v = uc(despace($v));
  if      ($v eq 'FROM') { 
    $from = despace($vv);
  } elsif ($v eq 'ID') { 
    $id = despace($vv);
  } elsif ($v eq 'SKEY') { 
    $skey = despace($vv);
    if (open $skey,'<',"$skeydir/$skey") {
      while (<$skey>) {
        if (/^(\w+)=(.+)/) {
          $from = $2 if lc($1) eq 'from';
          $to   = $2 if lc($1) eq 'to';
          $id   = $2 if lc($1) eq 'id';
        }
      }
      close $skey;
    }
  } elsif ($v eq 'AKEY') { 
    $akey = despace($vv);
    if (open $idf,'<',"$akeydir/$ra:$akey/@" and $id = <$idf>) {
      chomp $id;
      close $idf;
      $from = readlink "$akeydir/$ra:$akey" 
        or http_die("internal server error: no $akey symlink");
      $from =~ s:.*/::;
      if ($akey ne md5_hex("$from:$id")) {
        http_die("wrong AKEY");
      }
    }
  }
}

# remove all white space
sub despace {
  local $_ = shift;
  s/\s//g;
  return $_;
}
