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