cgi-bin/foc

   1 #!/usr/bin/perl -wT
   2
   3 # FEX CGI for (user) operation control
   4 #
   5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
   6 #
   7
   8 BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
   9
  10 use utf8;
  11 use Fcntl       qw(:flock);
  12 use Digest::MD5 qw(md5_hex);
  13
  14 # add fex lib
  15 ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
  16 die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  17
  18 our ($FEXHOME,$mdomain,$nomail,$faillog);
  19 our $akey = '';
  20
  21 # load common code, local config : $HOME/lib/fex.ph
  22 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  23
  24 my $error = 'F*EX operation control ERROR';
  25
  26 chdir $spooldir or die "$spooldir - $!\n";
  27
  28 $akeydir = "$spooldir/.akeys";
  29 $user = $id = '';
  30
  31 # look for CGI parameters
  32 our %PARAM;
  33 &parse_parameters;
  34 foreach my $v (keys %PARAM) {
  35   my $vv = $PARAM{$v};
  36   # debuglog("Param: $v=\"$vv\"");
  37   if ($v =~ /^akey$/i and $vv =~ /^(\w+)$/) {
  38     $akey = $1;
  39   } elsif ($v =~ /^(from|user)$/i) {
  40     $user = normalize_email($vv);
  41     $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  42   } elsif ($v =~ /^id$/i) {
  43     $id = checkchars($vv);
  44   }
  45 }
  46
  47 if ($akey and not $user and not $id) {
  48   if (open $akey,'<',"$akeydir/$akey/@" and $id = getline($akey)) {
  49     close $akey;
  50     $user = readlink "$akeydir/$akey"
  51       or http_die("internal server error: no $akey symlink");
  52     $user =~ s:.*/::;
  53     $user = untaint($user);
  54     if ($akey ne md5_hex("$user:$id")) {
  55       $user = $id = '';
  56     }
  57   }
  58 }
  59
  60 $head = "$ENV{SERVER_NAME} F*EX operation control";
  61
  62 # display HTML form and request user data
  63 if ($user and $id) {
  64   my $idf;
  65   unless (open $idf,'<',"$user/@") {
  66     faillog("user $from, id $id");
  67     html_error($error,"wrong user or auth-ID");
  68   }
  69   &check_status($user);
  70   if (-e "$user/\@CAPTIVE") { html_error($error,"captive user") }
  71   $rid = getline($idf);
  72   close $idf;
  73   if ($id eq $rid) {
  74     unless ($akey) {
  75       $akey = untaint(md5_hex("$user:$id"));
  76       unlink "$akeydir/$akey";
  77       symlink "../$user","$akeydir/$akey";
  78     }
  79   } else {
  80     faillog("user $from, id $id");
  81     html_error($error,"wrong user or auth-ID");
  82   }
  83   unlink $faillog if $faillog;
  84   http_header("200 OK");
  85   print html_header($head);
  86   # authorized login URL
  87   my $url = "$ENV{PROTO}://$ENV{HTTP_HOST}/fup/".b64("from=$user&id=$id");
  88   pq(qq(
  89     '<script>'
  90     '  function show_user() { return(alert('
  91     '       "server:\\t$ENV{HTTP_HOST}\\n"+'
  92     '       "user:\\t$user\\n"+'
  93     '       "auth-ID:\\t$id\\n"+'
  94     '       "URL:\\t\\t$url"'
  95     '  ));}'
  96     '</script>'
  97     '<h2>for user <a href="#" onclick="show_user();" title="click to see account data">$user</a></h2>'
  98     '<table>'
  99   ));
 100   ($quota,$du) = check_sender_quota($user);
 101   if ($quota) {
 102     pq(qq(
 103       <tr title="You as the sender have a server disk quota of $quota MB and currently using $du MB">
 104         <td>sender quota (used):<td align=\"right\">$quota ($du) MB
 105       </tr>
 106     ));
 107   }
 108   ($quota,$du) = check_recipient_quota($user);
 109   if ($quota) {
 110     pq(qq(
 111       <tr title="You as the recipient have a server disk quota of $quota MB and currently using $du MB">
 112         <td>recipient quota (used):<td align=\"right\">$quota ($du) MB
 113       </tr>
 114     ));
 115   }
 116   pq(qq(
 117     '</table>'
 118     '<p><hr><p>'
 119     '<a href="/fup?akey=$akey&command=LISTRECEIVED">'
 120     'Retrieve a list of all your received files</a> in F*EX spool.'
 121   ));
 122   pq(qq(
 123     '<p><hr><p>'
 124     '<form action="/fuc?akey=$akey"'
 125     '      method="post"'
 126     '      accept-charset="UTF-8"'
 127     '      enctype="multipart/form-data">'
 128     '  <input type="hidden" name="user" value="$user">'
 129     '  <input type="hidden" name="id"   value="$id">'
 130     '  <script>function show_id() {return(alert("auth-ID: $id"));}</script>'
 131     '  Change your <a href="#" onclick="show_id();" title="$id">auth-ID</a> to'
 132     '  <input type="text"   name="nid"  size="16">'
 133     '  <input type="submit" value="remember it!">'
 134   ));
 135   if (-s "$user/\@ALLOWED_RECIPIENTS") {
 136     # pq(qq(
 137     #  '  (You are a restricted user)';
 138     #  '  <p>'
 139     # ));
 140     #    '<p><hr><p>'
 141     #    '<a href="/fup?akey=$akey&command=LISTSENT">'
 142     #    'Show download URLs of files you have sent</a>.'
 143     unless ($nomail) {
 144       pq(qq(
 145         '<p><hr><p>'
 146         '<a href="/fup?akey=$akey&command=RENOTIFY">'
 147         'Resend notification e-mails for files you have sent</a>.'
 148       ));
 149     }
 150   } else {
 151     pq(qq(
 152       '<p><hr><p>'
 153       '<a href="/fup?akey=$akey&command=LIST&to=*">'
 154       'Forward a copy of a file</a> you already have uploaded to another recipient.'
 155       '<p><hr><p>'
 156       '<a href="/rup?akey=$akey">'
 157       'Redirect files</a> you have uploaded to a wrong or misspelled recipient.'
 158     ));
 159     unless ($nomail) {
 160       pq(qq(
 161         '<p><hr><p>'
 162         '<a href="/fup?akey=$akey&command=RENOTIFY">'
 163         'Resend notification e-mails for files you have sent</a>.'
 164       ));
 165     }
 166     pq(qq(
 167       '<p><hr><p>'
 168       '  Create a subuser who can send you files. Enter his e-mail address:<br>'
 169       '  <input type="text" name="subuser" size="60">'
 170       '  <input type="checkbox" name="otuser" value="once">for only one upload<br>'
 171     ));
 172     if ($nomail) {
 173       pq(qq(
 174         '  <input type="submit" value="create subuser">'
 175       ));
 176     } else {
 177       pq(qq(
 178         '  Comment to send with information e-mail:<br>'
 179         '  <input type="text" name="comment" size="80"><br>'
 180         '  <input type="submit" value="create subuser and send e-mail">'
 181       ));
 182     }
 183     pq(qq(
 184       '  <p><hr><p>'
 185       '  <a href="/fuc?akey=$akey">Manage your subusers and groups</a>'
 186       '  <p><hr><p>'
 187       '  <a href="/fuc?ab=load&akey=$akey">Edit your address book</a>'
 188     ));
 189     pq(qq(
 190       '  <p><hr><p>'
 191       '  <a href="/fuc?disclaimer=CHANGE&akey=$akey">'
 192       '  Change the disclaimer</a> to be sent with notification e-mail.'
 193     ));
 194   }
 195   pq(qq(
 196     '  <p><hr><p>'
 197     '  <a href="/fuc?encryption=CHANGE&akey=$akey">'
 198     '  (De)activate e-mail encryption</a>.'
 199   )) if -s "$ENV{HOME}/.gnupg/pubring.gpg";
 200   if ((readlink "$user/\@NOTIFICATION"||'') =~ /short/i) {
 201     pq(qq(
 202       '  <p><hr><p>'
 203       '  Get <a href="/fuc?notification=detailed&akey=$akey">detailed</a> notification e-mails (current setting: <em>brief</em>).'
 204     ));
 205   } else {
 206     pq(qq(
 207       '  <p><hr><p>'
 208       '  Get <a href="/fuc?notification=short&akey=$akey">brief</a> notification e-mails (current setting: <em>detailed</em>).'
 209     ));
 210   }
 211   if ((readlink "$user/\@REMINDER"||'') =~ /no/i) {
 212     pq(qq(
 213       '  <p><hr><p>'
 214       '  Get <a href="/fuc?reminder=yes&akey=$akey">reminder</a> notification e-mails (current setting: <em>no reminders</em>).'
 215     ));
 216   } else {
 217     pq(qq(
 218       '  <p><hr><p>'
 219       '  Get <a href="/fuc?reminder=no&akey=$akey">no reminder</a> notification e-mails (current setting: <em>send reminders</em>).'
 220     ));
 221   }
 222   if (-e "$user/\@MIME") {
 223     pq(qq(
 224       '  <p><hr><p>'
 225       '  <a href="/fuc?mime=no&akey=$akey">Save</a> files after download (current setting: <em>display</em>).'
 226     ));
 227   } else {
 228     pq(qq(
 229       '  <p><hr><p>'
 230       '  <a href="/fuc?mime=yes&akey=$akey">Display</a> files when downloading with web browser (current setting: <em>save</em>).'
 231     ));
 232   }
 233   pq(qq(
 234     '  <p><hr><p>'
 235     '  <a href="/fup?akey=$akey">Back to fup (upload page)</a>'
 236     '</form>'
 237   ));
 238   print &logout;
 239   print "</body></html>\n";
 240   exit;
 241 }
 242
 243 my $login = -x "$FEXHOME/login" ? 'login' : 'fup';
 244 nvt_print(
 245   "HTTP/1.1 302 Found",
 246   "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/$login",
 247   'Expires: 0',
 248   'Content-Length: 0',
 249   ''
 250 );
 251 &reexec;