#!/usr/bin/perl -wT

# FEX CGI for operation control
#
# 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 ($mdomain);

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

my $error = 'F*EX operation control ERROR';

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

$akeydir = "$spooldir/.akeys"; 
$akey = $user = $id = '';
$ra = untaint($ENV{REMOTE_ADDR});

# look for CGI parameters
foreach my $v (param) {
  $vv = param($v);
  $vv =~ s/[ \t\000]//g;
  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;
      $user = readlink "$akeydir/$ra:$akey"
        or http_die("internal server error: no $akey symlink");
      $user =~ s:.*/::;
      $user = untaint($user);
      if ($akey ne md5_hex("$user:$id")) {
        $user = $id = '';
      }
    }
  } elsif ($v =~ /^(from|user)$/i) {
    $vv =~ s:/::g;
    next if $vv eq '.' or $vv eq '..';
    $user = untaint($vv);
    $user .= '@'.$mdomain if $user !~ /@/;
  } elsif ($v =~ /^id$/i) {
    $id = $vv;
  }
}

if ($user and $id) {
  open F,'<',"$user/@" or html_error($error,"wrong user or auth-ID");
  chomp($rid = <F>||'');
  close F;
  if ($id eq $rid) {
    unless ($akey) {
      $akey = untaint(md5_hex("$user:$id"));
      symlink "../$user","$akeydir/$ra:$akey";
    }
  } else {
    html_error($error,"wrong user or auth-ID");
  }
}

$head = "$ENV{SERVER_NAME} F*EX operation control";
http_header("200 OK");
print html_header($head);


# display HTML form and request user data
if ($user and $id) {
  pq(qq(
    '<h2>for user $user</h2>'
    '<a href ="/fup?akey=$akey&COMMENT=LIST">'
    'Retrieve a list of all your files</a> in F*EX spool.'
    '<p>'
    '<a href ="/rup?akey=$akey">'
    'Redirect files</a> you have uploaded to wrong or misspelled recipient.'
    '<p>'
    '<form action="/fuc"'
    '      method="post"'
    '      accept-charset="UTF-8"'
    '      enctype="multipart/form-data">'
    '  <input type="hidden" name="user" value="$user">'
    '  <input type="hidden" name="id"   value="$id">'
    'Allow'
    '<input type="text" name="subuser" size="40">'
    'to send files to you.<br>'
    '<input type="submit" value="Enter a valid e-mail address for your sub-user">'
    '<p>'
    '<a href ="/fuc?akey=$akey">'
    'Change your auth-ID or manage your sub-users</a>.'
    '<p>'
    '<a href ="/fuc?ab=load&akey=$akey">'
    'Edit your address book</a>.'
    '<p>'
    '<a href ="/fup?akey=$akey">'
    'Back to fup (upload page)</a>.'
    '<p>'
    '</body></html>'
  ));
} else {
  $submit = "continue";
  pq(qq(
    '<form action="$ENV{SCRIPT_NAME}" method="post"'
    ' accept-charset="UTF-8" enctype="multipart/form-data">'
    '<table>'
    '  <tr><td>user:'
    '      <td><input type="text"     name="user" size="40" value="$user"></tr>'
    '  <tr><td>auth-ID:'
    '      <td><input type="password" name="id"   size="16" value="$id"></tr>'
    '</table>'
    '<p>'
    '<input type="submit" value="$submit">'
    '</form>'
    '</body></html>'
  ));
}
