]> git.treefish.org Git - fex.git/blobdiff - cgi-bin/fup
projects / fex.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Original release 20150615
[fex.git] / cgi-bin / fup
diff --git a/cgi-bin/fup b/cgi-bin/fup
index d43cda0edcd0402d228427ff2ce36959591a031a..b1e01e631acbe9d0b653e557827a4e4a1c2f7a63 100755 (executable)
--- a/cgi-bin/fup
+++ b/cgi-bin/fup
@@ -8,20 +8,16 @@
 #      Sebastian Zaiser <szcode@arcor.de> (upload status)
 #
 
 #      Sebastian Zaiser <szcode@arcor.de> (upload status)
 #
 
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
+
 use Encode;
 use Fcntl              qw':flock :seek :mode';
 use IO::Handle;
 use Digest::MD5                qw'md5_hex';
 use Encode;
 use Fcntl              qw':flock :seek :mode';
 use IO::Handle;
 use Digest::MD5                qw'md5_hex';
-use CGI::Carp          qw'fatalsToBrowser';
 use Cwd                        qw'abs_path';
 
 use Cwd                        qw'abs_path';
 
-use constant DS => 60*60*24;
-use constant M  => 1024*1024;
-
 # add fex lib
 # add fex lib
-die "$0: no \$FEXLIB\n" unless $ENV{FEXLIB};
 (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
 (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
-die "$0: no $FEXLIB\n" unless -d $FEXLIB;
 
 $| = 1;
 
 
 $| = 1;
 
@@ -39,10 +35,12 @@ our (@registration_hosts,@demo,@file_link_dirs);
 
 # import from fex.pp
 our ($FEXHOME);
 
 # import from fex.pp
 our ($FEXHOME);
-our ($spooldir,$durl,$tmpdir,$logdir,$docdir,$hostname,$admin,$fra);
-our ($keep_default,$recipient_quota,$sender_quota);
+our ($spooldir,$durl,$tmpdir,@logdir,$logdir,$docdir,$hostname,$admin,$fra);
+our ($keep_default,$recipient_quota,$sender_quota,$fex_yourself);
 our ($sendmail,$mdomain,$fop_auth,$mail_auth,$faillog);
 our ($dkeydir,$ukeydir,$akeydir,$skeydir,$gkeydir,$xkeydir);
 our ($sendmail,$mdomain,$fop_auth,$mail_auth,$faillog);
 our ($dkeydir,$ukeydir,$akeydir,$skeydir,$gkeydir,$xkeydir);
+our ($MB,$DS);
+our $RB;               # read POST bytes (total)
 our $akey = '';
 our $dkey = '';
 our $skey = '';
 our $akey = '';
 our $dkey = '';
 our $skey = '';
@@ -54,7 +52,6 @@ our $fpsize = 0;      # file part size (MIME-part)
 
 my $data;
 my $boundary;
 
 my $data;
 my $boundary;
-my $rb = 0;            # read bytes, totally
 my $rid = '';          # real ID
 my @header;            # HTTP entity header
 my $fileid;            # file ID
 my $rid = '';          # real ID
 my @header;            # HTTP entity header
 my $fileid;            # file ID
@@ -62,18 +59,18 @@ my $captive;
 my $muser;             # main user fur sub or group user
   
 # load common code, local config: $FEXLIB/fex.ph
 my $muser;             # main user fur sub or group user
   
 # load common code, local config: $FEXLIB/fex.ph
-require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
+require "$FEXLIB/fex.pp";
 
 # load fup local config
 our ($info_1,$info_2,$info_login);
 
 $locale = $ENV{LOCALE} || 'english';
 
 # load fup local config
 our ($info_1,$info_2,$info_login);
 
 $locale = $ENV{LOCALE} || 'english';
-foreach my $pl (
+foreach (
   "/var/lib/fex/locale/$locale/lib/fup.pl", 
   "$FEXLIB/fup.pl",
 ) {
   "/var/lib/fex/locale/$locale/lib/fup.pl", 
   "$FEXLIB/fup.pl",
 ) {
-  if (-f $pl) {
-    require $pl or die "$0: cannot load $FEXLIB/fup.pl - $!\n";
+  if (-f) {
+    require;
     last;
   }
 }
     last;
   }
 }
@@ -82,7 +79,7 @@ foreach my $pl (
 
 chdir $spooldir or http_die("$spooldir - $!\n");
 
 
 chdir $spooldir or http_die("$spooldir - $!\n");
 
-my $log = "$logdir/fup.log";
+my $log = 'fup.log';
 
 my $http_client = $ENV{HTTP_USER_AGENT} || '';
 my $cl = $ENV{X_CONTENT_LENGTH} || $ENV{CONTENT_LENGTH} || 0;
 
 my $http_client = $ENV{HTTP_USER_AGENT} || '';
 my $cl = $ENV{X_CONTENT_LENGTH} || $ENV{CONTENT_LENGTH} || 0;
@@ -116,6 +113,10 @@ if ($addto) {
 
 $to = join(',',@to);
 
 
 $to = join(',',@to);
 
+if ($from eq $to and $fex_yourself =~ /^no|0$/i) {
+  http_die("fexing to yourself is not allowed");
+}
+
 $uid = randstring(8) unless $uid; # upload ID
 
 # user requests for forgotten ID
 $uid = randstring(8) unless $uid; # upload ID
 
 # user requests for forgotten ID
@@ -214,6 +215,11 @@ if ($from and $id and not ($gkey or $skey or $public or $okey)) {
   }
 }
 
   }
 }
 
+# optional $auth_hook() in fup.pl
+if ($auth_hook and ($akey or $skey or $gkey) and $from and -d $from) {
+  &$auth_hook;
+}
+
 # forward a copy of a file to another recipient
 if ($akey and $dkey and $command eq 'FORWARD') {
   my $file = untaint(readlink "$dkeydir/$dkey"||'');
 # forward a copy of a file to another recipient
 if ($akey and $dkey and $command eq 'FORWARD') {
   my $file = untaint(readlink "$dkeydir/$dkey"||'');
@@ -371,7 +377,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
       next if $file =~ m:(.+?)/: and -l $1;
       $size = -s "$file/data";
       next unless $size;
       next if $file =~ m:(.+?)/: and -l $1;
       $size = -s "$file/data";
       next unless $size;
-      $size = int($size/M+0.5);
+      $size = int($size/$MB+0.5);
       $filename = $comment = '';
       my $rto = $file;
       $rto =~ s:/.*::;
       $filename = $comment = '';
       my $rto = $file;
       $rto =~ s:/.*::;
@@ -394,7 +400,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
           close $file;
         }
         my $rkeep = untaint(readlink "$file/keep"||$keep_default)
           close $file;
         }
         my $rkeep = untaint(readlink "$file/keep"||$keep_default)
-                    - int((time-mtime("$file/filename"))/DS);
+                    - int((time-mtime("$file/filename"))/$DS);
         if ($comment =~ /NOMAIL/ or 
            (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) {
           printf "%8s MB [%s d] %s/%s/%s\n",
         if ($comment =~ /NOMAIL/ or 
            (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) {
           printf "%8s MB [%s d] %s/%s/%s\n",
@@ -438,11 +444,12 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
         next if $file =~ m:(.+?)/: and -l $1;
         $size = -s "$file/data";
         next unless $size;
         next if $file =~ m:(.+?)/: and -l $1;
         $size = -s "$file/data";
         next unless $size;
-        $size = int($size/M+0.5);
+        $size = int($size/$MB+0.5);
         $filename = $comment = '';
         my $rto = $file;
         $rto =~ s:/.*::;
         if ($dkey = readlink "$file/dkey") {
         $filename = $comment = '';
         my $rto = $file;
         $rto =~ s:/.*::;
         if ($dkey = readlink "$file/dkey") {
+        # die $file if -s "$file/data" and $file =~ /^$from/;
           if ($rto ne $to) {
             $to = $rto;
             print "\nto $to :\n";
           if ($rto ne $to) {
             $to = $rto;
             print "\nto $to :\n";
@@ -461,7 +468,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
             close $file;
           }
           my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
             close $file;
           }
           my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
-                      - int((time-mtime("$file/filename"))/DS);
+                      - int((time-mtime("$file/filename"))/$DS);
           printf "%8s MB [%s d] <a href=\"%s\">%s</a>%s\n",
                  $size,
                  $rkeep,
           printf "%8s MB [%s d] <a href=\"%s\">%s</a>%s\n",
                  $size,
                  $rkeep,
@@ -493,7 +500,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
           $filename = $comment = '';
           $size = -s "$file/data";
           next unless $size;
           $filename = $comment = '';
           $size = -s "$file/data";
           next unless $size;
-          $size = int($size/M+0.5);
+          $size = int($size/$MB+0.5);
           if ($dkey = readlink "$file/dkey") {
             print "\nfrom $from :\n" unless $url;
             $file =~ m:.*/(.+):;
           if ($dkey = readlink "$file/dkey") {
             print "\nfrom $from :\n" unless $url;
             $file =~ m:.*/(.+):;
@@ -516,7 +523,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
               close $file;
             }
             my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
               close $file;
             }
             my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
-                        - int((time-mtime("$file/filename"))/DS);
+                        - int((time-mtime("$file/filename"))/$DS);
             printf "[<a href=\"/fup?akey=%s&dkey=%s&command=DELETE\">delete</a>] ",
                    $akey,$dkey;
             printf "[<a href=\"/fup?akey=%s&dkey=%s&command=COPY\">forward</a>] ",
             printf "[<a href=\"/fup?akey=%s&dkey=%s&command=DELETE\">delete</a>] ",
                    $akey,$dkey;
             printf "[<a href=\"/fup?akey=%s&dkey=%s&command=COPY\">forward</a>] ",
@@ -584,9 +591,9 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
   
   if ($command eq 'RECEIVEDLOG') {
     http_die("illegal command \"$command\"") if $public or $anonymous;
   
   if ($command eq 'RECEIVEDLOG') {
     http_die("illegal command \"$command\"") if $public or $anonymous;
-    if (open my $fuplog,"$logdir/fup.log") {
+    if (open my $log,"$logdir/fup.log") {
       http_header('200 OK');
       http_header('200 OK');
-      while (<$fuplog>) {
+      while (<$log>) {
         next if /\sSTDFEX\s/;
         if (/\d+$/) { 
           my @F = split;
         next if /\sSTDFEX\s/;
         if (/\d+$/) { 
           my @F = split;
@@ -602,9 +609,9 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
 
   if ($command eq 'SENDLOG') {
     http_die("illegal command \"$command\"") if $public or $anonymous;
 
   if ($command eq 'SENDLOG') {
     http_die("illegal command \"$command\"") if $public or $anonymous;
-    if (open my $fuplog,"$logdir/fup.log") {
+    if (open my $log,"$logdir/fup.log") {
       http_header('200 OK');
       http_header('200 OK');
-      while (<$fuplog>) {
+      while (<$log>) {
         next if /\sSTDFEX\s/;
         if (/(\S+\@\S+)/ and $1 eq $from) { 
           s/ \[[\d_]+\]//;
         next if /\sSTDFEX\s/;
         if (/(\S+\@\S+)/ and $1 eq $from) { 
           s/ \[[\d_]+\]//;
@@ -694,14 +701,14 @@ if ($from and $id and $rid eq $id and @to and not $flink and not $seek) {
   
   # check sender quota
   ($quota,$du) = check_sender_quota($muser||$from);
   
   # check sender quota
   ($quota,$du) = check_sender_quota($muser||$from);
-  if ($quota and $du+$cl/M > $quota) {
+  if ($quota and $du+$cl/$MB > $quota) {
     http_die("you are overquota");
   }
   
   # check recipient quota
   foreach my $to (@to) {
     ($quota,$du) = check_recipient_quota($to);
     http_die("you are overquota");
   }
   
   # check recipient quota
   foreach my $to (@to) {
     ($quota,$du) = check_recipient_quota($to);
-    if ($quota and $du+$cl/M > $quota) {
+    if ($quota and $du+$cl/$MB > $quota) {
       http_die("$to cannot receive files: is overquota");
     }
   }
       http_die("$to cannot receive files: is overquota");
     }
   }
@@ -717,8 +724,7 @@ if ($id and $id eq $rid and $from and @to and not $public) {
 # (= has a F*EX ID)
 if (not $addto and $fop_auth and $id and $id eq $rid and $from and @to) {
   my ($to_reg,$idf,$subuser);
 # (= has a F*EX ID)
 if (not $addto and $fop_auth and $id and $id eq $rid and $from and @to) {
   my ($to_reg,$idf,$subuser);
-  foreach (@to) {
-    my $to = $_;
+  foreach my $to (my @loop = @to) {
     $to =~ s/:\w+=.*//; # remove options from address
     $to_reg = 0;
     # full user?
     $to =~ s/:\w+=.*//; # remove options from address
     $to_reg = 0;
     # full user?
@@ -794,8 +800,8 @@ unless ($file) {
     }
   }
   
     }
   }
   
-  # save default locale for this user
   if (($akey or $skey or $gkey) and $from and -d $from) {
   if (($akey or $skey or $gkey) and $from and -d $from) {
+    # save default locale for this user
     if (not $locale and ($ENV{HTTP_COOKIE}||'') =~ /\blocale=(\w+)/) {
       $locale = $1;
     }
     if (not $locale and ($ENV{HTTP_COOKIE}||'') =~ /\blocale=(\w+)/) {
       $locale = $1;
     }
@@ -836,8 +842,8 @@ unless ($file) {
     @ab = ("<option></option>");
     
     # select menu from server address book
     @ab = ("<option></option>");
     
     # select menu from server address book
-    if (open my $ab,'<',"$from/\@ADDRESS_BOOK") {
-      while (<$ab>) {
+    if (open my $AB,'<',"$from/\@ADDRESS_BOOK") {
+      while (<$AB>) {
         s/#.*//g;
         if (/(\S+)[=\s]+(\S+@[\w.-]+\S*)/) {
           $_ = "$1 &lt;$2>";
         s/#.*//g;
         if (/(\S+)[=\s]+(\S+@[\w.-]+\S*)/) {
           $_ = "$1 &lt;$2>";
@@ -845,7 +851,7 @@ unless ($file) {
           push @ab,"<option>$_</option>";
         }
       }
           push @ab,"<option>$_</option>";
         }
       }
-      close $ab;
+      close $AB;
     }
     
     unless (@to) {
     }
     
     unless (@to) {
@@ -909,12 +915,11 @@ unless ($file) {
       print "</pre><p>\n";
       close $rr;
     }
       print "</pre><p>\n";
       close $rr;
     }
-    pq(qq(
-      '  <input type="submit" name="submit" value="check recipient(s) and continue">'
-      '  or <input type="submit" name="fexyourself" value="fex yourself">'
-      '</form>'
-      '<p>'
-    ));
+    print qq'  <input type="submit" name="submit" value="check recipient(s) and continue">';
+    if ($fex_yourself =~ /^yes|1/i) {
+      print qq' or <input type="submit" name="fexyourself" value="fex yourself">'
+    }
+    print "\n</form>\n<p>\n";
     if ($akey and -f "$from/\@" and not $captive ) {
       pq(qq(
         '<a href="/foc?akey=$akey">user config & operation control</a>'
     if ($akey and -f "$from/\@" and not $captive ) {
       pq(qq(
         '<a href="/foc?akey=$akey">user config & operation control</a>'
@@ -948,13 +953,14 @@ unless ($file) {
   if ($from and ($id or $okey)) {
     $to = $group if $group;
     present_locales($ENV{REQUEST_URI}) if $skey or $gkey or $okey;
   if ($from and ($id or $okey)) {
     $to = $group if $group;
     present_locales($ENV{REQUEST_URI}) if $skey or $gkey or $okey;
+#      "        '$ENV{PROTO}://$ENV{HTTP_HOST}/$cgi?showstatus=$uid',"
     pq(qq(
       '<script type="text/javascript">'
       '  function showstatus() {'
       '    var file  = document.forms["upload"].elements["file"].value;'
       '    if (file != "") {'
       '      window.open('
     pq(qq(
       '<script type="text/javascript">'
       '  function showstatus() {'
       '    var file  = document.forms["upload"].elements["file"].value;'
       '    if (file != "") {'
       '      window.open('
-      "        '$ENV{PROTO}://$ENV{HTTP_HOST}/$cgi?showstatus=$uid',"
+      "        '/$cgi?showstatus=$uid',"
       "        'fup_status',"
       "        'width=700,height=500'"
       '      );'
       "        'fup_status',"
       "        'width=700,height=500'"
       '      );'
@@ -1060,7 +1066,7 @@ unless ($file) {
            ? "<tr><td>sender quota (used):<td>$quota ($du) MB</tr>" 
            : '';
     
            ? "<tr><td>sender quota (used):<td>$quota ($du) MB</tr>" 
            : '';
     
-    $bwl = qq'<td><input type="text" name="bwlimit" size="8" value="$bwlimit"> kB/s';
+    $bwl = qq'<input type="text" name="bwlimit" size="8" value="$bwlimit"> kB/s';
     if (@throttle) {
       foreach (@throttle) {
         if (/\[?(.+?)\]?:(\d+)$/) {
     if (@throttle) {
       foreach (@throttle) {
         if (/\[?(.+?)\]?:(\d+)$/) {
@@ -1069,7 +1075,7 @@ unless ($file) {
           # throttle ip address?
           if ($throttle =~ /^[\w:.-]+$/) {
             if (ipin($ra,$throttle)) {
           # throttle ip address?
           if ($throttle =~ /^[\w:.-]+$/) {
             if (ipin($ra,$throttle)) {
-              $bwl = qq'<td><input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
+              $bwl = qq'<input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
               last;
             }
           } 
               last;
             }
           } 
@@ -1079,7 +1085,7 @@ unless ($file) {
             $throttle =~ quotemeta $throttle;
             $throttle =~ s/\*/.*/g;
             if ($from =~ /^$throttle$/i) {
             $throttle =~ quotemeta $throttle;
             $throttle =~ s/\*/.*/g;
             if ($from =~ /^$throttle$/i) {
-              $bwl = qq'<td><input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
+              $bwl = qq'<input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
               last;
             }
           }
               last;
             }
           }
@@ -1096,36 +1102,35 @@ unless ($file) {
       elsif (/delay/i) { $adt = 'delete file after download with delay' } 
       elsif (/^\d+$/)  { $adt = "delete file $autodelete days after download" }
     }
       elsif (/delay/i) { $adt = 'delete file after download with delay' } 
       elsif (/^\d+$/)  { $adt = "delete file $autodelete days after download" }
     }
+    $adt .= qq'<input type="hidden" name="autodelete" value="$autodelete">';
 
     my $ctr = my $ktr = '';
     if ($nomail) {
 
     my $ctr = my $ktr = '';
     if ($nomail) {
-      $ctr = qq'<td><input type="hidden" name="comment" value="$comment">'
-            .qq'<em>no notification e-mail will be send</em>';
-      $ktr = qq'<input type="text" name="keep" size="2" value="$keep"> days</tr>';
-      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep"></tr>';
+      $ctr = qq'<em>no notification e-mail will be send</em>';
     } else {
     } else {
-      $ctr = qq'<td><input type="text" name="comment" size="80" value="$comment">';
-      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep"></tr>';
+      $ctr = qq'<input type="text" name="comment" size="80" value="$comment">';
     }
     if ($captive) {
     }
     if ($captive) {
-      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep"></tr>';
+      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep">';
+    } else {
+      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep">';
     }
     }
-    
     pq(qq(
     pq(qq(
-      '    <tr title="$adt"><td>autodelete:<td>$adt</tr>'
-      '    <input type="hidden" name="autodelete" value="$autodelete">'
-      '    <tr title="keep file max $keep days, then delete it"><td>keep:<td>'
-      '    $ktr'
+      '    <tr><td>autodelete:'
+      '      <td>$adt'
+      '    </tr>'
+      '    <tr title="keep file max $keep days, then delete it"><td>keep:'
+      '      <td>$ktr'
+      '    </tr>'
       '    $quota'
       '    <tr title="optional, full speed if empty"><td>bandwith limit:'
       '    $quota'
       '    <tr title="optional, full speed if empty"><td>bandwith limit:'
-      '      $bwl'
+      '      <td>$bwl'
       '    </tr>'
       '    <tr title="optional, will be included in notification e-mail"><td>comment:'
       '    </tr>'
       '    <tr title="optional, will be included in notification e-mail"><td>comment:'
-      '      $ctr'
+      '      <td>$ctr'
       '    </tr>'
       '    </tr>'
-      '    <tr title="If you want to send more than one file, then put them in a zip or tar archive">'
-      '        <td>file:'
-      '        <td><input type="file" name="file" size="80" value="$file" onchange="reportsize();">'
+      '    <tr title="If you want to send more than one file, then put them in a zip or tar archive"><td>file:'
+      '      <td><input type="file" name="file" size="80" value="$file" onchange="reportsize();">'
       '    </tr>'
       '    <tr><td>file size:<td id="filesize"></td></tr>'
       '  </table>'
       '    </tr>'
       '    <tr><td>file size:<td id="filesize"></td></tr>'
       '  </table>'
@@ -1297,11 +1302,14 @@ if (not $anonymous and $overwrite =~ /^n/i) {
 }
 
 # additional last check
 }
 
 # additional last check
-foreach $to (@to) {
-  checkaddress($to) or 
-    http_die("<code>$to</code> is not a valid e-mail address");
+unless (@group or $gkey or $skey or $public or $okey) {
+  foreach $to (@to) {
+    checkaddress($to) or 
+      http_die("<code>$to</code> is not a valid e-mail address");
+  }
 }
 
 }
 
+
 $to = join(',',@to);
 
 # file overwriting for anonymous is only possible if his client has the 
 $to = join(',',@to);
 
 # file overwriting for anonymous is only possible if his client has the 
@@ -1353,14 +1361,9 @@ unless ($nostore) {
     rename $upload,$save or http_die("cannot rename $upload to $save - $!\n");
     
     # log dkey
     rename $upload,$save or http_die("cannot rename $upload to $save - $!\n");
     
     # log dkey
-    my $dlog = "$logdir/dkey.log";
-    if (open $dlog,'>>',$dlog) {
-      flock $dlog,LOCK_EX;
-      seek $dlog,0,SEEK_END;
-      printf {$dlog} "%s %s %s %s %s\n",
-                     isodate(time),$dkey{$to},$from,$to,$fkey;
-      close $dlog;
-    }
+    my $msg = sprintf "%s %s %s %s %s\n",
+                      isodate(time),$dkey{$to},$from,$to,$fkey;
+    writelog('dkey.log',$msg);
     
     # send notification e-mails if necessary
     if (not $nomail and (readlink "$to/\@NOTIFICATION"||'') !~ /^no/i
     
     # send notification e-mails if necessary
     if (not $nomail and (readlink "$to/\@NOTIFICATION"||'') !~ /^no/i
@@ -1418,11 +1421,11 @@ if ($nostore) {
 print html_header($head);
 
 if ($nostore) {
 print html_header($head);
 
 if ($nostore) {
-  printf "%s (%s MB) received\n",$file,$ndata/M;
+  printf "%s (%s MB) received\n",$file,int($ndata/$MB);
 } elsif (not $restricted and ($anonymous or $from eq $to)) {
   my $size = $ndata<2*1024 ? sprintf "%s B",$ndata:
 } elsif (not $restricted and ($anonymous or $from eq $to)) {
   my $size = $ndata<2*1024 ? sprintf "%s B",$ndata:
-             $ndata<2*M           ? sprintf "%s kB",int($ndata/1024):
-                             sprintf "%s MB",int($ndata/M);
+             $ndata<2*$MB   ? sprintf "%s kB",int($ndata/1024):
+                             sprintf "%s MB",int($ndata/$MB);
   pq(qq(
     '<code>$file</code> ($size) received and saved<p>'
     'Download URL for copy & paste:'
   pq(qq(
     '<code>$file</code> ($size) received and saved<p>'
     'Download URL for copy & paste:'
@@ -1435,7 +1438,7 @@ if ($nostore) {
     if (not $boring and not $seek) {
       print "Ehh... $ndata <b>BYTES</b>?! You are kidding?<p>\n";
     }
     if (not $boring and not $seek) {
       print "Ehh... $ndata <b>BYTES</b>?! You are kidding?<p>\n";
     }
-  } elsif ($ndata<2*M) {
+  } elsif ($ndata<2*$MB) {
     $ndata = int($ndata/1024);
     print "<code>$file</code> ($ndata kB) received and saved<p>\n";
     if ($ndata<1024 and not ($boring or $seek)) {
     $ndata = int($ndata/1024);
     print "<code>$file</code> ($ndata kB) received and saved<p>\n";
     if ($ndata<1024 and not ($boring or $seek)) {
@@ -1443,7 +1446,7 @@ if ($nostore) {
         "ever heard of MIME e-mail? &#9786;<p>\n";
     }
   } else {
         "ever heard of MIME e-mail? &#9786;<p>\n";
     }
   } else {
-    $ndata = int($ndata/M);
+    $ndata = int($ndata/$MB);
     print "<code>$file</code> ($ndata MB) received and saved<p>\n";
   }
   print "<ul>\n";
     print "<code>$file</code> ($ndata MB) received and saved<p>\n";
   }
   print "<ul>\n";
@@ -1640,9 +1643,11 @@ sub parse_request {
   }
 
   if ($from) {
   }
 
   if ($from) {
-    $from .= '@'.$mdomain if $mdomain and $from !~ /@/;
-    if ($from ne 'anonymous' and not checkaddress($from)) {
-      http_die("<code>$from</code> is not a valid e-mail address");
+    unless ($skey or $gkey or $okey) {
+      $from .= '@'.$mdomain if $mdomain and $from !~ /@/;
+      if ($from ne 'anonymous' and not checkaddress($from)) {
+        http_die("<code>$from</code> is not a valid e-mail address");
+      }
     }
     $from = untaint($from);
   }
     }
     $from = untaint($from);
   }
@@ -1678,12 +1683,10 @@ sub parse_request {
 
     # look for recipient's options and eliminate dupes
     %to = ();
 
     # look for recipient's options and eliminate dupes
     %to = ();
-    foreach (@to) {
-     my $to = $_;
+    foreach my $to (my @loop = @to) {
      # address book alias?
      # address book alias?
-      if ($ab{$to}) {
-        foreach (@{$ab{$to}}) {
-          my $address = $_;
+      if ($to !~ /@/ and $ab{$to}) {
+        foreach my $address (my @loop = @{$ab{$to}}) {
           $address .= '@'.$mdomain if $mdomain and $address !~ /@/;
           $to{$address} = $address; # ignore dupes
           if ($specific{'autodelete'}) {
           $address .= '@'.$mdomain if $mdomain and $address !~ /@/;
           $to{$address} = $address; # ignore dupes
           if ($specific{'autodelete'}) {
@@ -1694,8 +1697,8 @@ sub parse_request {
             $autodelete{$address} = readlink "$address/\@AUTODELETE" 
                                     || $autodelete;
           }
             $autodelete{$address} = readlink "$address/\@AUTODELETE" 
                                     || $autodelete;
           }
-          if ($_ = readlink "$address/\@LOCALE") {
-            $locale{$address} = $_;
+          if (my $locale = readlink "$address/\@LOCALE") {
+            $locale{$address} = $locale;
           } elsif ($locale{$to}) {
             $locale{$address} = $locale{$to};
           } else {
           } elsif ($locale{$to}) {
             $locale{$address} = $locale{$to};
           } else {
@@ -1746,8 +1749,8 @@ sub parse_request {
           http_die("You cannot send to more than one group") if @to > 1;
           http_die("Group <code>$to</code> does not exist") unless -f "$from/\@GROUP/$1";
         } else {
           http_die("You cannot send to more than one group") if @to > 1;
           http_die("Group <code>$to</code> does not exist") unless -f "$from/\@GROUP/$1";
         } else {
-          $to .= '@'.$mdomain if $mdomain and $to !~ /@/;
-          if (checkaddress($to)) {
+          if ($skey or $gkey or $okey or checkaddress($to)) {
+            $to .= '@'.$mdomain if $mdomain and $to !~ /@/;
             $to{$to} = untaint($to);
           } else {
             http_die("<code>$to</code> is not a valid e-mail address");
             $to{$to} = untaint($to);
           } else {
             http_die("<code>$to</code> is not a valid e-mail address");
@@ -2014,6 +2017,7 @@ sub get_file {
              "$filed/speed",
              "$filed/replyto",
              "$filed/useragent",
              "$filed/speed",
              "$filed/replyto",
              "$filed/useragent",
+             "$filed/uurl",
              "$filed/comment",
              "$filed/notify";
       unlink "$filed/size" unless $seek;
              "$filed/comment",
              "$filed/notify";
       unlink "$filed/size" unless $seek;
@@ -2026,7 +2030,7 @@ sub get_file {
       close $fh;
       if ($::filesize > 0 or $cl > 0) {
         if ($::filesize > 0) { $filesize = $fpsize || $::filesize }
       close $fh;
       if ($::filesize > 0 or $cl > 0) {
         if ($::filesize > 0) { $filesize = $fpsize || $::filesize }
-        else                 { $filesize = $cl-$rb-$ebl+$seek }
+        else                 { $filesize = $cl-$RB-$ebl+$seek }
         # new file
         unless ($seek) {
           if ($::filesize > 0) {
         # new file
         unless ($seek) {
           if ($::filesize > 0) {
@@ -2041,9 +2045,14 @@ sub get_file {
         }
       }
     
         }
       }
     
-      $autodelete{$to} = $autodelete unless $autodelete{$to};
-      if ($autodelete{$to} =~ /^(DELAY|NO|\d+)$/i) {
-        mksymlink("$filed/autodelete",$autodelete{$to});
+      if ($from eq "@to") {
+        # special "fex yourself"
+        mksymlink("$filed/autodelete",'NO');
+      } else {
+        $autodelete{$to} = $autodelete unless $autodelete{$to};
+        if ($autodelete{$to} =~ /^(DELAY|NO|\d+)$/i) {
+          mksymlink("$filed/autodelete",$autodelete{$to});
+        }
       }
 
       if (my $keep = $keep{$to} || $::keep) {
       }
 
       if (my $keep = $keep{$to} || $::keep) {
@@ -2051,6 +2060,9 @@ sub get_file {
       }
       mksymlink("$filed/id",$fileid) if $fileid;
       mksymlink("$filed/ip",$ra)     if $ra;
       }
       mksymlink("$filed/id",$fileid) if $fileid;
       mksymlink("$filed/ip",$ra)     if $ra;
+      if (my $uurl = $ENV{REQUEST_URL}) {
+        mksymlink("$filed/uurl",$uurl);
+      }
       if ($http_client and open $http_client,'>',"$filed/useragent") {
         print {$http_client} $http_client,"\n";
         close $http_client;
       if ($http_client and open $http_client,'>',"$filed/useragent") {
         print {$http_client} $http_client,"\n";
         close $http_client;
@@ -2140,8 +2152,9 @@ sub get_file {
     if ($cl == -1) {
       alarm($timeout*2);
       # read until EOF, including MIME end boundary
     if ($cl == -1) {
       alarm($timeout*2);
       # read until EOF, including MIME end boundary
+      # note: cannot use sysread because of previous buffered read!
       while ($n = read(STDIN,$_,$bs)) {
       while ($n = read(STDIN,$_,$bs)) {
-        $rb += $n;
+        $RB += $n;
         $fb += $n;
         syswrite $upload,$_ unless $nostore;
         alarm($timeout*2);
         $fb += $n;
         syswrite $upload,$_ unless $nostore;
         alarm($timeout*2);
@@ -2156,31 +2169,31 @@ sub get_file {
       if ($fpsize) {
         debuglog(sprintf("still awaiting %d+%d = %d bytes",
                  $fpsize,$ebl,$fpsize+$ebl));
       if ($fpsize) {
         debuglog(sprintf("still awaiting %d+%d = %d bytes",
                  $fpsize,$ebl,$fpsize+$ebl));
-        $cl = $rb+$fpsize+$ebl; # recalculate CONTENT_LENGTH
+        $cl = $RB+$fpsize+$ebl; # recalculate CONTENT_LENGTH
       } else {
         if ($::filesize) {
       } else {
         if ($::filesize) {
-          $cl = $rb+$::filesize+$ebl; # recalculate CONTENT_LENGTH
+          $cl = $RB+$::filesize+$ebl; # recalculate CONTENT_LENGTH
         }
         debuglog(sprintf("still awaiting %d-%d = %d bytes",
         }
         debuglog(sprintf("still awaiting %d-%d = %d bytes",
-                         $cl,$rb,$cl-$rb));
+                         $cl,$RB,$cl-$RB));
       }
       # read until end boundary, not EOF
       }
       # read until end boundary, not EOF
-      while ($rb < $cl-$ebl) {
-        $b = $cl-$ebl-$rb; 
+      while ($RB < $cl-$ebl) {
+        $b = $cl-$ebl-$RB; 
         $b = $bs if $b > $bs;
         # max wait for 1 kB/s, but at least 10 s
         # $timeout = $b/1024;
         # $timeout = 10 if $timeout < 10;
         alarm($timeout);
         if ($n = read(STDIN,$_,$b)) {
         $b = $bs if $b > $bs;
         # max wait for 1 kB/s, but at least 10 s
         # $timeout = $b/1024;
         # $timeout = 10 if $timeout < 10;
         alarm($timeout);
         if ($n = read(STDIN,$_,$b)) {
-          $rb += $n;
+          $RB += $n;
           $fb += $n;
           # syswrite is much faster than print
           syswrite $upload,$_ unless $nostore;
           if ($bwlimit) {
             alarm(0);
             $tt = (time-$t0) || 1;
           $fb += $n;
           # syswrite is much faster than print
           syswrite $upload,$_ unless $nostore;
           if ($bwlimit) {
             alarm(0);
             $tt = (time-$t0) || 1;
-            while ($rb/$tt/1024 > $bwlimit) {
+            while ($RB/$tt/1024 > $bwlimit) {
               sleep 1;
               $tt = time-$t0;
             }
               sleep 1;
               $tt = time-$t0;
             }
@@ -2198,7 +2211,7 @@ sub get_file {
           http_die("found no MIME end boundary in upload ($_)");
         }
       }
           http_die("found no MIME end boundary in upload ($_)");
         }
       }
-      $rb += $ebl;
+      $RB += $ebl;
       $ndata = untaint($fb);
     } 
 
       $ndata = untaint($fb);
     } 
 
@@ -2239,12 +2252,12 @@ sub get_file {
         # truncate $upload,$ndata+$uss if -s $upload > $ndata+$uss;
       
         # incomplete?
         # truncate $upload,$ndata+$uss if -s $upload > $ndata+$uss;
       
         # incomplete?
-        if ($cl != $rb) {
+        if ($cl != $RB) {
           fuplog($to,$fkey,$ndata,'(aborted)');
           if ($fpsize) {
           fuplog($to,$fkey,$ndata,'(aborted)');
           if ($fpsize) {
-            http_die("read $rb bytes, but Content-Length announces $fpsize bytes");
+            http_die("read $RB bytes, but Content-Length announces $fpsize bytes");
           } else {
           } else {
-            http_die("read $rb bytes, but CONTENT_LENGTH announces $cl bytes");
+            http_die("read $RB bytes, but CONTENT_LENGTH announces $cl bytes");
           }
         }
       
           }
         }
       
@@ -2328,8 +2341,7 @@ sub expand {
   my @users = @_;
   my @ua;
   
   my @users = @_;
   my @ua;
   
-  foreach (@users) {
-    my $u = $_;
+  foreach my $u (my @loop = @users) {
     if ($u =~ /^anonymous(_\d+)?$/) { 
       $u = "$u\@$hostname";
     }
     if ($u =~ /^anonymous(_\d+)?$/) { 
       $u = "$u\@$hostname";
     }
@@ -2381,8 +2393,7 @@ sub forward {
     }
 
     # collect addresses
     }
 
     # collect addresses
-    foreach (@to) {
-      my $to = $_;
+    foreach my $to (my @loop = @to) {
       if ($ab{$to}) {
         foreach my $address (@{$ab{$to}}) {
           $to{$address} = $address;
       if ($ab{$to}) {
         foreach my $address (@{$ab{$to}}) {
           $to{$address} = $address;
@@ -2398,8 +2409,7 @@ sub forward {
 
     @to = keys %to;
     
 
     @to = keys %to;
     
-    foreach (@to) {
-      my $to = $_;
+    foreach my $to (my @loop = @to) {
       $to =~ s/:\w+=.*//; # remove options from address
       $nfile = $file;
       $nfile =~ s:.*?/:$to/:;
       $to =~ s/:\w+=.*//; # remove options from address
       $nfile = $file;
       $nfile =~ s:.*?/:$to/:;
@@ -2535,29 +2545,6 @@ sub calcsize {
 }
 
 
 }
 
 
-# read one line from STDIN (net socket) and assign it to $_
-# returns number of read bytes
-sub nvt_read {
-  my $len = 0;
-
-  if (defined ($_ = <STDIN>)) {
-    debuglog($_);
-    $len = length;
-    $rb += $len;
-    s/\r?\n//;
-  }
-  return $len;
-}
-
-
-# read forward to given pattern
-sub nvt_skip_to {
-  my $pattern = shift;
-
-  while (&nvt_read) { return if /$pattern/ }
-}
-
-
 # set parameter variables
 sub setparam {
   my ($v,$vv) = @_;
 # set parameter variables
 sub setparam {
   my ($v,$vv) = @_;
@@ -2604,7 +2591,8 @@ sub setparam {
     $from = normalize_email($vv);
     $from = untaint(expand($from));
     checkchars('from address',$from);
     $from = normalize_email($vv);
     $from = untaint(expand($from));
     checkchars('from address',$from);
-    checkaddress($from) or http_die("FROM $from is no legal e-mail address");
+    # maybe FROM=SUBUSER !
+    # checkaddress($from) or http_die("FROM $from is no legal e-mail address");
   } elsif ($v eq 'REPLYTO') { 
     $replyto = normalize_email($vv);
     checkchars('replyto address',$replyto);
   } elsif ($v eq 'REPLYTO') { 
     $replyto = normalize_email($vv);
     checkchars('replyto address',$replyto);
@@ -2891,7 +2879,7 @@ sub check_space {
     while (<$df>) {
       if (/^.+?\s+\d+\s+\d+\s+(\d+)/ and $req/1024 > $1) {
         $free = int($1/1024);
     while (<$df>) {
       if (/^.+?\s+\d+\s+\d+\s+(\d+)/ and $req/1024 > $1) {
         $free = int($1/1024);
-        $uprq = int($req/M);
+        $uprq = int($req/$MB);
         if (not $nomail and open P,"|$sendmail -t") {
           pq(P,qq(
             'From: $admin'
         if (not $nomail and open P,"|$sendmail -t") {
           pq(P,qq(
             'From: $admin'
@@ -2929,14 +2917,9 @@ sub fuplog {
   
   $msg =~ s/\n/ /g;
   $msg =~ s/\s+$//;
   
   $msg =~ s/\n/ /g;
   $msg =~ s/\s+$//;
-  
-  if (open $log,'>>',$log) {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    printf {$log} "%s [%s_%s] %s (%s) %s\n",
-                  isodate(time),$$,$ENV{REQUESTCOUNT},$from,$fra,$msg;
-    close $log;
-  }
+  $msg = sprintf "%s [%s_%s] %s (%s) %s\n",
+                 isodate(time),$$,$ENV{REQUESTCOUNT},$from,$fra,$msg;
+  writelog($log,$msg);
 }
 
 
 }
 
 
@@ -2958,19 +2941,17 @@ sub sigexit {
   $msg = @_ ? "@_" : '???';
   $msg =~ s/\n/ /g;
   $msg =~ s/\s+$//;
   $msg = @_ ? "@_" : '???';
   $msg =~ s/\n/ /g;
   $msg =~ s/\s+$//;
+  $msg = sprintf "%s %s (%s) %s %s caught SIGNAL %s %s\n",
+                 isodate(time),
+                 $from||'-',
+                 $fra||'-',
+                 $to||'-',
+                 encode_Q($file||'-'),
+                 $msg,
+                 $RB?"(after $RB bytes)":"";
+  
+  writelog($log,$msg);
   
   
-  if (open $log,'>>',$log) {
-    printf {$log} 
-           "%s %s (%s) %s %s caught SIGNAL %s %s\n",
-           isodate(time),
-           $from||'-',
-           $fra||'-',
-           $to||'-',
-           encode_Q($file||'-'),
-           $msg,
-           $rb?"(after $rb bytes)":"";
-    close $log;
-  }
   if ($sig eq 'DIE') {
     shift;
     die "$msg\n";
   if ($sig eq 'DIE') {
     shift;
     die "$msg\n";
@@ -2980,12 +2961,6 @@ sub sigexit {
 }
 
 
 }
 
 
-sub mtime {
-  my @s = lstat shift;
-  return @s ? $s[9] : undef;
-}
-
-
 sub present_locales {
   my $url = shift;
   my @locales = @::locales; # from fex.ph
 sub present_locales {
   my $url = shift;
   my @locales = @::locales; # from fex.ph
@@ -3006,8 +2981,7 @@ sub present_locales {
 
   if (@locales > 1) {
     print "<h3>";
 
   if (@locales > 1) {
     print "<h3>";
-    foreach (@locales) {
-      $locale = $_;
+    foreach my $locale (my @loop = @locales) {
       if (-x "$locale/cgi-bin/fup") {
         $lang = "$locale/lang.html";
         $locale =~ s:.*/::;
       if (-x "$locale/cgi-bin/fup") {
         $lang = "$locale/lang.html";
         $locale =~ s:.*/::;
Unofficial F*EX git repository tracking official releases.