#!/usr/bin/perl -wT

# FEX CGI for (user) operation control
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#

BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }

# use utf8;
use Fcntl 	qw(:flock);
use Digest::MD5	qw(md5_hex);

# add fex lib
($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
die "$0: no $FEXLIB\n" unless -d $FEXLIB;

our ($FEXHOME,$mdomain,$nomail,$faillog,$skeydir,$akeydir);
our ($archive_sharing,$document_exchange);
our $akey = '';

# 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";

$user = $id = '';

# look for CGI parameters
our %PARAM;
&parse_parameters;
foreach my $v (keys %PARAM) {
  my $vv = $PARAM{$v};
  # debuglog("Param: $v=\"$vv\"");
  if ($v =~ /^akey$/i and $vv =~ /^(\w+)$/) {
    $akey = $1;
  } elsif ($v =~ /^(from|user)$/i) {
    $user = normalize_email($vv);
    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  } elsif ($v eq 'show') {
    $show = normalize_email($vv);
  } elsif ($v =~ /^id$/i) {
    $id = checkchars($vv);
  }
}

if ($akey and not $user and not $id) {
  if ($id = readline1("$akeydir/$akey/@")) {
    $user = readlink "$akeydir/$akey"
      or http_die("internal server error: no $akey symlink");
    $user =~ s:.*/::;
    $user = untaint($user);
  }
}

$head = "$ENV{SERVER_NAME} F*EX operation control";

# display HTML form and request user data
if ($user and $id) {
  my $idf;
  unless (open $idf,'<',"$user/@") {
    faillog("user $user, id $id");
    html_error($error,"wrong user or auth-ID");
  }
  &check_status($user);
  if (-e "$user/\@CAPTIVE") { html_error($error,"captive user") }
  $rid = getline($idf);
  close $idf;
  if ($id eq $rid) {
    unless ($akey) {
      $akey = genakey($user);
    }
  } else {
    faillog("user $user, id $id");
    html_error($error,"wrong user or auth-ID");
  }
  unlink $faillog if $faillog;
  http_header("200 OK");
  print html_header($head);
  # authorized login URL
  my $url = "$ENV{PROTO}://$ENV{HTTP_HOST}/fup/".b64("from=$user&id=$id");
  # own subuser URL
  my $skey = untaint(md5_hex($id));
  mksymlink("$skeydir/$skey",$user);
  my $surl = "$ENV{PROTO}://$ENV{HTTP_HOST}/fup?skey=$skey";
  if ($show) {
    pq(qq(
      '<table>'
#     '<tr><td>server:   <td>$ENV{HTTP_HOST}</tr>'
      '<tr><td>user:     <td>$user</tr>'
      '<tr><td>auth-ID:  <td>$id</tr>'
      '<tr><td>login URL:<td>$url</tr>'
      '<tr><td>self URL: <td>$surl</tr>'
      '</table>'
      '<p>'
      '<a href="#" onclick="window.close()">close</a>'
      '</body></html>'
    ));
    exit;
  }
  pq(qq(
    '<script>'
    'function show_user() {'
    '  window.open("/foc?show=$user","show user","width=1024,height=300");'
    '}'
    '</script>'
    '<h2>for user <a href="#" onclick="show_user()" title="click to see account data"> $user</a></h2>'
    '<table>'
  ));
  ($quota,$du) = check_sender_quota($user);
  if ($quota) {
    pq(qq(
      '<tr title="You as the sender have a server disk quota of $quota MB and currently using $du MB">'
      '<td>sender quota (used):<td align="right">$quota<td>($du) MB'
      '</tr>'
    ));
  }
  ($quota,$du) = check_recipient_quota($user);
  if ($quota) {
    pq(qq(
      '<tr title="You as the recipient have a server disk quota of $quota MB and currently using $du MB">'
      '<td>recipient quota (used):<td align="right">$quota<td>($du) MB'
      '</tr>'
    ));
  }
  pq(qq(
    '</table>'
    '<p><hr><p>'
    '<ul>'
    '<p><li>'
    '<a href="/fup?command=LISTRECEIVED">'
    'Retrieve a list of all your received files</a> in F*EX spool.'
    '<p><li>'
    '<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">'
    '  <script>function show_id() {return(alert("auth-ID: $id"));}</script>'
    '  Change your <a href="#" onclick="show_id();" title="$id">auth-ID</a> to'
    '  <input type="text"   name="nid"  size="16">'
    '  <input type="submit" value="remember it!">'
  ));
  if (-s "$user/\@ALLOWED_RECIPIENTS") {
    # pq(qq(
    #  '  (You are a restricted user)';
    #  '  <p>'
    # ));
    #    '<p><li>'
    #    '<a href="/fup?akey=$akey&command=LISTSENT">'
    #    'Show download URLs of files you have sent</a>.'
    unless ($nomail) {
      pq(qq(
        '<p><li>'
        '<a href="/fup?command=RENOTIFY">'
        'Resend notification emails for files you have sent</a>.'
      ));
    }
  } else {
    pq(qq(
      '<p><li>'
      '<a href="/fup?command=LIST&to=*">'
      'Forward a copy of a file</a> you already have uploaded to another recipient.'
      '<p><li>'
      '<a href="/rup">'
      'Redirect files</a> you have uploaded to a wrong or misspelled recipient.'
    ));
    unless ($nomail) {
      pq(qq(
        '<p><li>'
        '<a href="/fup?command=RENOTIFY">'
        'Resend notification emails for files you have sent</a>.'
      ));
    }
    pq(qq(
      '<p><li>'
      '  <a href="/fup?from=$user&id=$id&COMMAND=GENUKEY">'
      '  Create one day valid upload key and URL</a> (to give away)'
      '<p><li>'
      '  Create a subuser who can send you files. Enter his email address:<br>'
      '  <input type="text" name="subuser" size="60">'
      '  <input type="checkbox" name="otuser" value="once">for only one upload<br>'
    ));
    if ($nomail) {
      pq(qq(
        '  <input type="submit" value="create subuser">'
      ));
    } else {
      pq(qq(
        '  Comment to send with information email:<br>'
        '  <input type="text" name="comment" size="80"><br>'
        '  <input type="submit" value="create subuser and send email">'
      ));
    }
    pq(qq(
      '<p><li>'
      '  <a href="/fuc">Manage your subusers and groups</a>'
    ));
    my $sharing = readlink_("$user/\@ARCHIVE_SHARING");
    if ($sharing =~ /yes/i or $archive_sharing and $sharing !~ /no/i) {
      pq(qq(
        '<p><li>'
        '  <a href="/fas">Manage your share archives and users</a>'
      ));
    }
    my $doxua = readlink_("$user/\@DOCUMENT_EXCHANGE");
    if ($doxua eq 'yes' or not $doxua and $document_exchange) {
      pq(qq(
        '<p><li>'
        '  <a href="/dox">Manage your document exchange</a>'
      ));
    }
    pq(qq(
      '<p><li>'
      '  <a href="/fuc?ab=load">Edit your address book</a>'
      '<p><li>'
      '  <a href="/fuc?disclaimer=CHANGE">'
      '  Change the disclaimer</a> to be sent with notification email.'
    ));
  }
  pq(qq(
    '<p><li>'
    '  <a href="/fuc?gpg=CHANGE">'
    '  (De)activate email encryption</a>.'
  )) if -s "$ENV{HOME}/.gnupg/pubring.gpg";
  if ((readlink "$user/\@NOTIFICATION"||'') =~ /short/i) {
    pq(qq(
      '<p><li>'
      '  Get <a href="/fuc?notification=detailed">detailed</a> notification emails (current setting: <em>brief</em>).'
    ));
  } else {
    pq(qq(
      '<p><li>'
      '  Get <a href="/fuc?notification=short">brief</a> notification emails (current setting: <em>detailed</em>).'
    ));
  }
  if ((readlink "$user/\@REMINDER"||'') =~ /no/i) {
    pq(qq(
      '<p><li>'
      '  Get <a href="/fuc?reminder=yes">reminder</a> notification emails (current setting: <em>no reminders</em>).'
    ));
  } else {
    pq(qq(
      '<p><li>'
      '  Get <a href="/fuc?reminder=no">no reminder</a> notification emails (current setting: <em>send reminders</em>).'
    ));
  }
  if (-e "$user/\@MIME") {
    pq(qq(
      '<p><li>'
      '  <a href="/fuc?mime=no">Save</a> files after download (current setting: <em>display</em>).'
    ));
  } else {
    pq(qq(
      '<p><li>'
      '  <a href="/fuc?mime=yes">Display</a> files when downloading with web browser (current setting: <em>save</em>).'
    ));
  }
  my $fidb64=b64("$ENV{PROTO}://$ENV{HTTP_HOST} $user $id");
  pq(qq(
    '</form>'
    '</ul>'
    '<p>'
    'Hint: to create a local FEXID file for <a href="/tools.html">fexsend</a>, use:<br>'
    '<b><code>fexsend -I FEXID=$fidb64</code></b>'
    '<p><hr><p>'
    '<a href="/fup">back to fup (upload page)</a>'
  ));
  print &logout;
  print "</body></html>\n";
  exit;
}

my $login = -x "$FEXHOME/login" ? 'login' : 'fup';
nvt_print(
  "HTTP/1.1 302 Found",
  "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/$login",
  'Expires: 0',
  'Content-Length: 0',
  ''
);
&reexec;
