#!/usr/bin/perl -wT

# CGI for stream exchange
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#
# Copyright: GNU General Public License

use Fcntl 	qw(:flock :seek :mode);
use IO::Handle;
use POSIX	qw(mkfifo);
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 $debug;
# import from fex.pp
our ($tmpdir,$logdir,$timeout,$fra);
my $bs = 1024;

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

our $debuglog = "$tmpdir/sex.log";

chdir $spooldir or error(500,"$spooldir - $!");

$fra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};

$user = $id = $rid = $pmode = $type = '';
$sid = $ENV{SID} || '';
$stream = 'STDSTR';
$mode = $ENV{REQUEST_METHOD} eq 'POST' ? 'PUSH' : 'POP';

# parse HTTP QUERY_STRING
foreach (split '&',$ENV{QUERY_STRING}) { setparam(split '=',"$_=") };

error(400,"Missing user") unless $user;
error(404,"Unknown user") unless -d $user;
chdir $user or error(500,"$user - $!");

$stream = "STREAM/$stream";

if ($mode eq 'PUSH') {
  unless (-d 'STREAM') {
    mkdir 'STREAM',0700 or error(503,"Cannot create STREAM : $!");
  }
  $stream = 'STREAM/PUBLIC' if $pmode eq 'PUBLIC' and $stream eq 'STREAM/STDSTR';
#  if (-e $stream) {
#    error(409,"Stream already in use");
#  }
  unless (-p $stream) {
    mkfifo($stream,0600) or error(503,"Cannot create $stream : $!");
  }
  $fmode = (stat $stream)[2];
  if ($pmode eq 'PUBLIC') { $fmode = $fmode|S_IROTH }
  else	 		  { $fmode = $fmode&~S_IROTH }
  if ($type eq 'TEXT')    { $fmode = $fmode|S_ISVTX }
  else	 		  { $fmode = $fmode&~S_ISVTX }
  chmod $fmode,$stream;
  $SIG{ALRM} = sub { unlink $stream; error(504,"Timeout") };
  alarm($timeout*10);
  # will hang until $stream is opend for reading by another process
  open F,'>',$stream or error(503,"Cannot open $stream : $!");
  flock F,LOCK_EX|LOCK_NB or error(409,"$stream already in use");
  autoflush F 1;
  header('200 OK');
  $SIG{ALRM} = $SIG{PIPE} = sub { unlink $stream; exit; };
  sexlog($mode);
  $SIG{ALRM} = sub { unlink $stream; exit; };
  alarm(0);
  if ($type eq 'TEXT') {
    while (<STDIN>) {
      print F;
#      alarm($timeout*10);
    }
  } else {
    while (read(STDIN,$_,$bs)) {
      print F;
#      alarm($timeout*10);
    }
  }
  alarm(0);
  unlink $stream;
} elsif ($mode eq 'POP') {
  $stream = 'STREAM/PUBLIC' if $id eq 'public' and $stream eq 'STREAM/STDSTR';
  @stat = stat $stream;
  if (@stat and not $stat[2]&S_IROTH) {
    error(400,"Missing auth-ID") unless $id;
    open F,'<','@' or error(401,"$user has no auth-ID");
    chomp($rid = <F>||'');
    close F;
    $rid = $1 . md5_hex($rid.$sid) if $rid and $sid and $id =~ /^(MD5H:)/;
    error(401,"Wrong auth-ID") unless $rid eq $id;
    # error(401,"Wrong auth-ID $rid $sid $id") unless $rid eq $id;
  }
  $SIG{ALRM} = sub { error(504,"Timeout") };
  alarm($timeout*10);
  open F,'<',$stream or error(503,"Cannot open $stream : $!");
  alarm(0);
  $type = 'TEXT' if -k $stream;
  header('200 OK',$type);
  sexlog($mode);
  if (-k $stream) {
    print while <F>;
  } else {
    print while (read(F,$_,$bs));
  }
} else {
  error(405,"Unknown Request");
}

exit;

sub normalize {
  local $_ = shift;
  s/^\s+//;
  s/\s+$//;
  s/[\000-\037\200-\237]/_/g;
  return $_;
}

sub despace {
  local $_ = shift;
  s/\s//g;
  return $_;
}

sub setparam {
  my ($v,$vv) = @_;
  
  $v = uc(despace($v));
  $vv = untaint(normalize($vv));
  # $param{$v} = $vv;
  if    ($v eq 'USER') 		  	{ $user	  = lc(despace($vv)) }
  elsif ($v eq 'ID') 			{ $id	  = despace($vv) } 
  elsif ($v eq 'MODE') 			{ $pmode  = uc(despace($vv)) } 
  elsif ($v eq 'TYPE') 			{ $type   = uc(despace($vv)) } 
  elsif ($v eq 'STREAM') 		{ $stream = normalize_filename($vv) }
  elsif ($v eq 'BS' and $vv =~ /(\d+)/) { $bs	  = $1 }
}

sub sexlog {
  if (open L,'>>',"$logdir/sex.log") {
    flock L,LOCK_EX;
    seek L,0,SEEK_END;
    printf L "%s %s (%s) @_\n",isodate(time),$user,$fra;
    close L;
  }
}

sub sigdie {
  local $_ = shift;
  chomp;
  sigexit('DIE',$_);
}

sub sigexit {
  my ($sig) = @_;
  if (open L,'>>',"$logdir/sex.log") {
    printf L "%s %s (%s) caught SIGNAL @_\n",
             isodate(time),$user||'-',$fra||'-';
    close L;
  }
  if ($sig eq 'DIE') {
    shift;
    die "@_\n";
  } else {
    die "SIGNAL @_\n";
  }
}

sub error {
  nvt_print("HTTP/1.1 @_");
  exit;
}

sub header {
  my ($status,$type) = @_;

  return if $HTTP_HEADER;
  $HTTP_HEADER = $status;

  nvt_print("HTTP/1.1 $status");
  if ($mode eq 'POP') {
    nvt_print("Server: sexsrv");
    if ($type eq 'TEXT') {
      nvt_print("Content-Type: text/plain");
    } else {
      nvt_print("Content-Type: application/binary");
    }
    nvt_print("Expires: 0");
    nvt_print("Cache-Control: no-cache");
    nvt_print("Connection: close");
  }
  nvt_print("");
  
}
