X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/97b87610331f53e756d032ad21db786037f921a1..20160919:/cgi-bin/fop?ds=sidebyside

diff --git a/cgi-bin/fop b/cgi-bin/fop
index a0eb824..c5098fc 100755
--- a/cgi-bin/fop
+++ b/cgi-bin/fop
@@ -7,6 +7,7 @@
 
 BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
 
+use utf8;
 use Fcntl 		qw':flock :seek';
 use Cwd			qw'abs_path';
 use File::Basename;
@@ -90,15 +91,16 @@ if ($file =~ m:^([^/]+)/[^/]+$:) {
 
   if ($ENV{REQUEST_METHOD} eq 'GET' and $file =~ m:.+/(.+)/.+:) {
     $from = lc $1;
-    if (-s "$from/\@ALLOWED_RECIPIENTS") { 
+    if (-s "$from/\@ALLOWED_RECIPIENTS") {
       http_die("$from is a restricted user");
     }
   }
-    
+
   # add mail-domain to addresses if necessary
   if ($mdomain and $file =~ s:(.+)/(.+)/(.+):$3:) {
     $to   = lc $1;
     $from = lc $2;
+    $to   =~ s/[:,].*//;
     $to   .= '@'.$hostname if $to   eq 'anonymous';
     $from .= '@'.$hostname if $from eq 'anonymous';
     $to   .= '@'.$mdomain if -d "$to\@$mdomain";
@@ -140,7 +142,7 @@ if ($qs = $ENV{QUERY_STRING}) {
 
   # workaround for broken F*IX
   $qs =~ s/&ID=skey:\w+//;
-  
+
   # subuser with skey?
   if ($qs =~ s/&*SKEY=([\w:]+)//i) {
     $skey = $1;
@@ -172,7 +174,7 @@ if ($qs = $ENV{QUERY_STRING}) {
       http_die("wrong SKEY authentification");
     }
   }
-  
+
   # group member with gkey?
   if ($qs =~ s/&*GKEY=([\w:]+)//i) {
     $gkey = $1;
@@ -213,12 +215,12 @@ if ($qs = $ENV{QUERY_STRING}) {
       http_die("wrong GKEY authentification");
     }
   }
-  
+
   # check for ID in query
   elsif ($qs =~ s/\&*\bID=([^&]+)//i) {
     $id = $1;
     $fop_auth = 0;
-    
+
     if ($id eq 'PUBLIC') {
       http_header('403 Forbidden');
       exit;
@@ -241,7 +243,7 @@ if ($qs = $ENV{QUERY_STRING}) {
     }
 
     # public or anonymous recipient? (needs no auth-ID for sender)
-    if ($anonymous or $id eq 'PUBLIC' and 
+    if ($anonymous or $id eq 'PUBLIC' and
         @public_recipients and grep /^\Q$to\E$/i,@public_recipients) {
       $rid = $id;
     } else {
@@ -250,12 +252,12 @@ if ($qs = $ENV{QUERY_STRING}) {
       close $idf;
       $rid = sidhash($rid,$id);
     }
-      
+
     unless ($id eq $rid) {
       debuglog("real id=$rid, id sent by user=$id");
       http_die("wrong auth-ID");
     }
-    
+
     # set akey link for HTTP sessions
     # (need original id for consistant non-moving akey)
     if (-d $akeydir and open $idf,'<',"$from/@" and my $id = getline($idf)) {
@@ -263,7 +265,7 @@ if ($qs = $ENV{QUERY_STRING}) {
       unlink "$akeydir/$akey";
       symlink "../$from","$akeydir/$akey";
     }
-    
+
     my %to;
     COLLECTTO: foreach my $to (split(',',$to)) {
       if ($to !~ /.@./ and open my $AB,'<',"$from/\@ADDRESS_BOOK") {
@@ -305,9 +307,9 @@ if ($qs = $ENV{QUERY_STRING}) {
         http_die("$to is not a legal e-mail address");
       }
     }
-      
+
   }
-  
+
   if ($qs =~ /\&?KEEP=(\d+)/i) {
     $keep = $1;
     $filename = filename($file);
@@ -332,15 +334,15 @@ if ($qs = $ENV{QUERY_STRING}) {
             "</body></html>\n";
     }
     exit;
-  } elsif ($qs =~ s/\&?KEEP//i) { 
+  } elsif ($qs =~ s/\&?KEEP//i) {
     check_captive($file);
     $autodelete = 'NO';
   }
-  
+
   if ($qs =~ s/\&?FILEID=(\w+)//i) { $fileid = $1 }
 
   if ($qs =~ s/\&?IGNOREWARNING//i) { $ignorewarning = 1 }
-  
+
   if ($qs eq 'LIST') {
     http_header('200 OK','Content-Type: text/plain');
     print "$file :\n";
@@ -372,7 +374,7 @@ if ($qs = $ENV{QUERY_STRING}) {
       http_die("File $file already exists in your outgoing spool.");
     }
     mkdirp("$to/$to/$file");
-    link "$to/$from/$file/data","$to/$to/$file/data" 
+    link "$to/$from/$file/data","$to/$to/$file/data"
       or http_die("cannot link to $to/$to/$file/data - $!\n");
     my $fkey = copy("$to/$from/$file/filename","$to/$to/$file/filename");
     open my $notify,'>',"$to/$to/$file/notify";
@@ -387,7 +389,7 @@ if ($qs = $ENV{QUERY_STRING}) {
       "</body></html>\n";
     exit;
   }
-  
+
   # ex and hopp?
   if ($qs =~ s/(^|&)DELETE//i) {
     if (unlink $data) {
@@ -410,12 +412,12 @@ if ($qs = $ENV{QUERY_STRING}) {
             "<h3>$filename deleted</h3>\n",
             "</body></html>\n";
       exit;
-    } else { 
+    } else {
       http_die("no such file");
     }
     exit;
-  } 
-  
+  }
+
   # wipe out!? (for anonymous upload)
   if ($qs =~ s/(^|&)PURGE//i) {
     $filename = filename($file);
@@ -434,15 +436,15 @@ if ($qs = $ENV{QUERY_STRING}) {
         print html_header($head),
           "<h3>$filename purged</h3>\n",
           "</body></html>\n";
-      } else { 
+      } else {
         http_die("no such file");
       }
-    } else { 
+    } else {
       http_die("you are not allowed to purge $filename");
     }
     exit;
-  } 
-  
+  }
+
   # request for file size?
   if ($qs eq '?') {
     sendsize($file);
@@ -509,7 +511,7 @@ if ($range = $ENV{HTTP_RANGE}) {
 if (not $autodelete or $autodelete ne 'NO') {
   $autodelete = readlink "$file/autodelete" || 'YES';
 }
-  
+
 if ($from and $file eq "$from/$from/ADDRESS_BOOK") {
   if (open my $AB,'<',"$from/\@ADDRESS_BOOK") {
     my $ab = '';
@@ -550,21 +552,20 @@ if (-f $data) {
       and $file !~ /\/STDFEX$/            # xx is ok!
       and (slurp("$file/comment")||'') !~ /^!\*!/ # multi download allow flag
       and not($dkey and ($ENV{HTTP_COOKIE}||'') =~ /dkey=$dkey/)
-      and open $file,'<',"$file/download") 
+      and open $file,'<',"$file/download")
   {
-    $_ = <$file> || '';
+    my $d1 = <$file> || ''; # first download
+    chomp $d1;
     close $file;
-    chomp;
     if ($ra) {
       # allow downloads from same ip
-      $_ = '' if /\Q$ra/;
+      $d1 = '' if $d1 =~ /\Q$ra/;
       # allow downloads from sender ip
-      $_ = '' if (readlink("$file/ip")||'') eq $ra;
+      $d1 = '' if (readlink("$file/ip")||'') eq $ra;
     }
-    if ($_) {
-      s/(.+) ([\w.:]+)$/by $2 at $1/;
+    if ($d1 and $d1 =~ s/(.+) ([\w.:]+)$/$2 at $1/) {
       $file = filename($file);
-      http_die("$file has already been downloaded $_");
+      http_die("$file has already been downloaded by $d1");
     }
   }
   $sb = sendfile($file,$seek,$stop);
@@ -587,14 +588,14 @@ debuglog(sprintf("%s %s %d %d %d",
          isodate(time),$file,$sb||0,$seek,-s $data||0));
 
 if ($sb+$seek == -s $data) {
-  
+
   # note successfull download
   $download = "$file/download";
   if (open $download,'>>',$download) {
     printf {$download} "%s %s\n",isodate(time),$ENV{REMOTE_ADDR};
     close $download;
   }
-  
+
   # delete file after grace period
   if ($autodelete eq 'YES') {
     $grace_time = 60 unless defined $grace_time;
@@ -613,26 +614,26 @@ if ($sb+$seek == -s $data) {
       close $error;
     }
   }
-  
+
 }
 
 exit;
-  
+
 
 sub sendfile {
   my ($file,$seek,$stop) = @_;
   my ($filename,$size,$total_size,$fileid,$filetype);
   my ($data,$download,$header,$buf,$range,$s,$b,$t0);
   my $type = '';
-  
+
   # swap to and from for special senders, see fup storage swap!
   $file =~ s:^(_?anonymous_.*)/(anonymous.*)/:$2/$1/:;
   $file =~ s:^(_?fexmail_.*)/(fexmail.*)/:$2/$1/:;
-  
+
   $data     = $file.'/data';
   $download = $file.'/download';
   $header   = $file.'/header';
-  
+
   # fallback defaults, should be set later with better values
   $filename = filename($file);
   $total_size = -s $data || 0;
@@ -675,12 +676,12 @@ sub sendfile {
       }
     }
     $size = $total_size - $seek - ($stop ? $total_size-$stop-1 : 0);
-  } elsif ($ENV{REQUEST_METHOD} eq 'HEAD') { 
+  } elsif ($ENV{REQUEST_METHOD} eq 'HEAD') {
     $size = -s $data || 0;
-  } else { 
+  } else {
     http_die("unknown HTTP request method $ENV{REQUEST_METHOD}");
   }
-  
+
   # read MIME entity header (what the client said)
   if (open $header,'<',$header) {
     while (<$header>) {
@@ -692,9 +693,9 @@ sub sendfile {
     close $header;
     $type =~ s/\s//g;
   }
-  
+
   $fileid = readlink "$file/id" || '';
-  
+
   # determine own MIME entity header for download
   my $mime = $file;
   $mime =~ s:/.*:/\@MIME:;
@@ -717,7 +718,7 @@ sub sendfile {
   }
   # reset to default MIME type
   else { $type = 'application/octet-stream' }
-  
+
   # HTML is not allowed for security reasons! (embedded javascript, etc)
   $type =~ s/html/plain/i;
 
@@ -733,6 +734,7 @@ sub sendfile {
     } else {
       $range = sprintf("bytes %s-%s/%s",$seek,$total_size-1,$total_size);
     }
+    # RFC 7233 "Responses to a Range Request"
     nvt_print(
       'HTTP/1.1 206 Partial Content',
       "Content-Length: $size",
@@ -747,7 +749,7 @@ sub sendfile {
     }
     nvt_print('');
   } else {
-    # another stupid IE bug-workaround 
+    # another stupid IE bug-workaround
     # http://drupal.org/node/163445
     # http://support.microsoft.com/kb/323308
     if ($http_client =~ /MSIE/ and not $nowarning) {
@@ -764,6 +766,7 @@ sub sendfile {
           "Connection: close",
         );
 #        nvt_print('','HTTP/1.1 200 OK',"Content-Length: $size","Content-Type: $type"); exit;
+        nvt_print($_) foreach(@extra_header);
       } else {
         http_header('200 OK');
         print html_header($head);
@@ -795,6 +798,7 @@ sub sendfile {
       if ($type eq 'application/octet-stream') {
         nvt_print(qq'Content-Disposition: attachment; filename="$filename"');
       }
+      nvt_print($_) foreach(@extra_header);
     }
 
     nvt_print("X-Size: $total_size");
@@ -813,7 +817,7 @@ sub sendfile {
     # control back to fexsrv for further HTTP handling
     &reexec;
   }
-  
+
   if ($ENV{REQUEST_METHOD} eq 'GET') {
 
     if (@throttle) {
@@ -829,7 +833,7 @@ sub sendfile {
               $bwl = $limit;
               last;
             }
-          } 
+          }
           # throttle e-mail address?
           else {
             # allow wildcard *, but not regexps
@@ -843,7 +847,7 @@ sub sendfile {
         }
       }
     }
-    
+
     foreach my $sig (keys %SIG) { local $SIG{$sig} = \&sigexit }
     local $SIG{ALRM} = sub { die "TIMEOUT\n" };
 
@@ -859,7 +863,7 @@ sub sendfile {
         $b = $size-$s;
         $buf = substr($buf,0,$b)
       }
-      $s += $b;      
+      $s += $b;
       alarm($timeout*10);
       syswrite STDOUT,$buf or last; # client still alive?
       if ($bwl) {
@@ -867,14 +871,14 @@ sub sendfile {
         sleep 1 while $s/(time-$t0||1)/1024 > $bwl;
       }
     }
-    
+
     close $data;
     alarm(0);
-    
+
     fdlog($log,$file,$s,$size);
   }
   close $download;
-  
+
   return $s;
 }
 
@@ -884,13 +888,13 @@ sub sendsize {
   my ($file,$upload,$to,$from,$dkey);
   my $size = 0;
   local $_;
-  
+
   $path =~ s:^/::;
   ($to,$from,$file) = split('/',$path);
   $to =~ s/,.*//;
   $to   = lc $to;
   $from = lc $from;
-  
+
   # swap to and from for special senders, see fup storage swap!
   ($from,$to) = ($to,$from) if $from =~ /^(fexmail|anonymous)/;
 
@@ -905,7 +909,7 @@ sub sendsize {
 
   if ($to eq '*' and $fileid) {
     foreach my $fd (glob "*/$from/$file") {
-      if (-f "$fd/data" 
+      if (-f "$fd/data"
           and -l "$fd/id" and readlink "$fd/id" eq $fileid
           and $dkey = readlink "$fd/dkey") {
         $to = $fd;
@@ -929,12 +933,12 @@ sub sendsize {
     }
     close $AB;
   }
-  
+
   if (-f "$to/$from/$file/data") {
     $dkey = readlink "$to/$from/$file/dkey";
     $fkey = slurp("$to/$from/$file/filename")||$file;
   }
-  
+
   $upload = -s "$to/$from/$file/upload" || -s "$to/$from/$file/data" || 0;
   $size = readlink "$to/$from/$file/size" || 0;
   $fileid = readlink "$to/$from/$file/id" || '';
@@ -1000,11 +1004,11 @@ sub check_auth {
 
   if ($path =~ m:(.+)/(.+)/(.+):) {
     ($to,$from,$file) = ($1,$2,$3);
-  } elsif ($path =~ m:(.+)/(.+):) {  
+  } elsif ($path =~ m:(.+)/(.+):) {
     ($dkey,$file) = ($1,$2);
     $path = readlink "$dkeydir/$dkey" or http_die('no such file');
     (undef,$to,$from,$file) = split('/',$path);
-  } else { 
+  } else {
     http_die("wrong URL format for download");
   }
 
@@ -1028,15 +1032,15 @@ sub check_auth {
       debuglog("$user mismatch: id=$id, auth=$auth");
       &require_auth;
     }
-  } 
+  }
   # check for sub user
   elsif (open $idf,'<',"$from/\@SUBUSER") {
     while (<$idf>) {
       chomp;
       s/#.*//;
       ($subuser,$subid) = split ':';
-      if ($subid and $subid eq $auth 
-          and ($user eq $subuser 
+      if ($subid and $subid eq $auth
+          and ($user eq $subuser
                or $subuser eq '*@*'
                or $subuser =~ /^\*\@(.+)/ and $user =~ /\@\Q$1\E$/i
                or $subuser =~ /(.+)\@\*$/ and $user =~ /^\Q$1\E\@/i)) {
@@ -1053,7 +1057,7 @@ sub check_auth {
     debuglog("no $to/@ and no $from/@");
     &require_auth;
   }
-  
+
 }
 
 
@@ -1070,7 +1074,7 @@ sub check_captive {
 sub sigexit {
   my ($sig) = @_;
   my $msg;
-  
+
   $msg = @_ ? "@_" : '???';
   $msg =~ s/\n/ /g;
   $msg =~ s/\s+$//;