#!/usr/bin/perl -wT

# FEX CGI for redirect uploaded files
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#
# Copyright: GNU General Public License

use CGI         qw(:standard);
use CGI::Carp	qw(fatalsToBrowser);
use Fcntl 	qw(:flock);
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;

our ($keep_default,$dkeydir,$akeydir,$mdomain);

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

our $error = 'F*EX redirect ERROR';

chdir $spooldir or die "$spooldir - $!\n";

$from = $id = $oto = $nto = $file = $akey = '';
$ra = untaint($ENV{REMOTE_ADDR});

# look for CGI parameters
foreach my $v (param) {
  $vv = param($v);
  if ($v =~ /^akey$/i) { 
    $vv =~ s:/::g;
    next if $vv eq '.' or $vv eq '..';
    $akey = untaint($vv);
    if (open $akey,'<',"$akeydir/$ra:$akey/@" and $id = <$akey>) {
      chomp $id;
      close $akey;
      $from = readlink "$akeydir/$ra:$akey";
      $from =~ s:.*/::;
      $from = untaint($from);
      if ($akey ne md5_hex("$from:$id")) {
        $from = $id = '';
      }
    }
  } elsif ($v =~ /^(from|user)$/i) {
    $vv =~ s:/::g;
    $from = untaint($vv);
  } elsif ($v =~ /^id$/i) {
    $id = despace($vv);
  } elsif ($v =~ /^file$/i) {
    $file =~ s:/:_:g;
    $file = untaint(normalize($vv));
  } elsif ($v =~ /^oto$/i) {
    $oto = normalize_address($vv);
  } elsif ($v =~ /^nto$/i) {
    $nto = normalize_address($vv);
    $nto .= '@'.$mdomain if $nto !~ /@/ and $nto =~ /\w/;
  }
}

if ($from and $id) {
  open F,'<',"$from/@" or http_die("wrong user or auth-ID");
  chomp($rid = <F>);
  close F;
  http_die("wrong user or auth-ID") if $id ne $rid;
}

if ($oto and not glob("$oto/$from/*")) {
  http_die("$oto has no no files in spool from you ($from)");
}

# display HTML form and request user data
unless ($from and $id and $file and $oto and $nto) {
  $head = "$ENV{SERVER_NAME} F*EX redirect";
  http_header("200 OK");
  print html_header($head);
  pq(qq(
    '<form action="$ENV{SCRIPT_NAME}" method="post"'
    ' accept-charset="UTF-8" enctype="multipart/form-data">'
    '  <table>'
  ));
  if ($akey) {
    print "<input type=\"hidden\" name=\"akey\"   value=\"$akey\">\n";
  } else {
    pq(qq(
      '    <tr><td>sender:'
      '        <td><input type="text"     name="from" size="80" value="$from"></tr>'
      '    <tr><td>auth-ID:'
      '        <td><input type="password" name="id"   size="16" value="$id"></tr>'
    ));
  }
  if ($oto) {
    pq(qq(
      '    <tr><td>old (wrong) recipient:<td>$oto</tr>'
      '        <input type="hidden" name="oto"   value="$oto">'
    ));
  } else {
    pq(qq(
      '    <tr><td>old (wrong) recipient:'
      '        <td><input type="text" 	   name="oto"  size="80" value="$oto"></tr>'
    ));
  }
  if ($from and $oto) {
  pq(qq(
    '    <tr><td>new recipient:'
    '        <td><input type="text" 	   name="nto"  size="80" value="$nto"></tr>'
    '    <tr><td>filename: <td><select name="file" size="1">'
  ));
    foreach my $file (glob "$oto/$from/*/data") {
      next if $file =~ m:/STDFEX/:;
      $file =~ s:/data$::;
      if (open $file,'<',"$file/filename") {
        my $filename = <$file> || '';
        close $file;
        if ($filename) {
          print "\t<option>$filename</option>\n";
        }
      }
    }
    print "    </tr>\n";
  }
  pq(qq(
    '  </table>'
    '  <p>'
    '  <input type="submit" value="submit">'
    '</form>'
    '</body></html>'
  ));
  exit;
}

if ($nto) {
  http_die("$nto is not a valid e-mail address") unless checkaddress($nto);
}

$fkey = urlencode($file);
unless (-s "$oto/$from/$fkey/data") {
  http_die("no upload data found for $file for $oto");
}

mkdirp("$nto/$from");
rmrf("$nto/$from/$fkey");

if (rename "$oto/$from/$fkey","$nto/$from/$fkey") {
  $dkey = untaint(readlink "$nto/$from/$fkey/dkey");
  unlink "$dkeydir/$dkey";
  symlink "../$nto/$from/$fkey","$dkeydir/$dkey";
  unlink "$nto/$from/$fkey/notify";
  unlink "$nto/$from/$fkey/error";
  if (open F,'<',"$nto/$from/$fkey/filename") {
    chomp($filename = <F>||'');
    close F;
  }
  $filename = '???' unless $filename;
  if (open F,'<',"$nto/$from/$fkey/keep") {
    chomp($keep = <F>||'');
    close F;
  }
  notify("new",$dkey,$filename,$keep||$keep_default,0,'');
  http_header("200 OK");
  print html_header('F*EX redirect');
  pq(qq(
    '<h3>F*EX redirect</h3>'
    'notification of file upload \"$filename\" sent to $nto'
    '<p>'
    '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
    '</body></html>'
  ));
} else {
  http_die("redirect $nto/$from/$fkey failed : $!")
}

exit;


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

sub normalize_address {
  local $_ = shift;
  s/[<>;,\|]//g;
  /(.*)/;
  $_ = $1;
}
