Original release 20150826

[fex.git] / cgi-bin / fop

diff --git a/cgi-bin/fop b/cgi-bin/fop
index a0eb824c6564f1207b0db7624cb48ced4737621a..fb37261f075b9b62a17c7b9869418f4c5828eebd 100755 (executable)
--- a/cgi-bin/fop
+++ b/cgi-bin/fop
@@ -90,11 +90,11 @@ if ($file =~ m:^([^/]+)/[^/]+$:) {
 
   if ($ENV{REQUEST_METHOD} eq 'GET' and $file =~ m:.+/(.+)/.+:) {
     $from = lc $1;
 
   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");
     }
   }
       http_die("$from is a restricted user");
     }
   }

-    
+

   # add mail-domain to addresses if necessary
   if ($mdomain and $file =~ s:(.+)/(.+)/(.+):$3:) {
     $to   = lc $1;
   # add mail-domain to addresses if necessary
   if ($mdomain and $file =~ s:(.+)/(.+)/(.+):$3:) {
     $to   = lc $1;


@@ -140,7 +140,7 @@ if ($qs = $ENV{QUERY_STRING}) {
 
   # workaround for broken F*IX
   $qs =~ s/&ID=skey:\w+//;
 
   # workaround for broken F*IX
   $qs =~ s/&ID=skey:\w+//;

-  
+

   # subuser with skey?
   if ($qs =~ s/&*SKEY=([\w:]+)//i) {
     $skey = $1;
   # subuser with skey?
   if ($qs =~ s/&*SKEY=([\w:]+)//i) {
     $skey = $1;


@@ -172,7 +172,7 @@ if ($qs = $ENV{QUERY_STRING}) {
       http_die("wrong SKEY authentification");
     }
   }
       http_die("wrong SKEY authentification");
     }
   }

-  
+

   # group member with gkey?
   if ($qs =~ s/&*GKEY=([\w:]+)//i) {
     $gkey = $1;
   # group member with gkey?
   if ($qs =~ s/&*GKEY=([\w:]+)//i) {
     $gkey = $1;


@@ -213,12 +213,12 @@ if ($qs = $ENV{QUERY_STRING}) {
       http_die("wrong GKEY authentification");
     }
   }
       http_die("wrong GKEY authentification");
     }
   }

-  
+

   # check for ID in query
   elsif ($qs =~ s/\&*\bID=([^&]+)//i) {
     $id = $1;
     $fop_auth = 0;
   # check for ID in query
   elsif ($qs =~ s/\&*\bID=([^&]+)//i) {
     $id = $1;
     $fop_auth = 0;

-    
+

     if ($id eq 'PUBLIC') {
       http_header('403 Forbidden');
       exit;
     if ($id eq 'PUBLIC') {
       http_header('403 Forbidden');
       exit;


@@ -241,7 +241,7 @@ if ($qs = $ENV{QUERY_STRING}) {
     }
 
     # public or anonymous recipient? (needs no auth-ID for sender)
     }
 
     # 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 {
         @public_recipients and grep /^\Q$to\E$/i,@public_recipients) {
       $rid = $id;
     } else {


@@ -250,12 +250,12 @@ if ($qs = $ENV{QUERY_STRING}) {
       close $idf;
       $rid = sidhash($rid,$id);
     }
       close $idf;
       $rid = sidhash($rid,$id);
     }

-      
+

     unless ($id eq $rid) {
       debuglog("real id=$rid, id sent by user=$id");
       http_die("wrong auth-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)) {
     # 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 +263,7 @@ if ($qs = $ENV{QUERY_STRING}) {
       unlink "$akeydir/$akey";
       symlink "../$from","$akeydir/$akey";
     }
       unlink "$akeydir/$akey";
       symlink "../$from","$akeydir/$akey";
     }

-    
+

     my %to;
     COLLECTTO: foreach my $to (split(',',$to)) {
       if ($to !~ /.@./ and open my $AB,'<',"$from/\@ADDRESS_BOOK") {
     my %to;
     COLLECTTO: foreach my $to (split(',',$to)) {
       if ($to !~ /.@./ and open my $AB,'<',"$from/\@ADDRESS_BOOK") {


@@ -305,9 +305,9 @@ if ($qs = $ENV{QUERY_STRING}) {
         http_die("$to is not a legal e-mail address");
       }
     }
         http_die("$to is not a legal e-mail address");
       }
     }

-      
+

   }
   }

-  
+

   if ($qs =~ /\&?KEEP=(\d+)/i) {
     $keep = $1;
     $filename = filename($file);
   if ($qs =~ /\&?KEEP=(\d+)/i) {
     $keep = $1;
     $filename = filename($file);


@@ -332,15 +332,15 @@ if ($qs = $ENV{QUERY_STRING}) {
             "</body></html>\n";
     }
     exit;
             "</body></html>\n";
     }
     exit;

-  } elsif ($qs =~ s/\&?KEEP//i) { 
+  } elsif ($qs =~ s/\&?KEEP//i) {

     check_captive($file);
     $autodelete = 'NO';
   }
     check_captive($file);
     $autodelete = 'NO';
   }

-  
+

   if ($qs =~ s/\&?FILEID=(\w+)//i) { $fileid = $1 }
 
   if ($qs =~ s/\&?IGNOREWARNING//i) { $ignorewarning = 1 }
   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";
   if ($qs eq 'LIST') {
     http_header('200 OK','Content-Type: text/plain');
     print "$file :\n";


@@ -372,7 +372,7 @@ if ($qs = $ENV{QUERY_STRING}) {
       http_die("File $file already exists in your outgoing spool.");
     }
     mkdirp("$to/$to/$file");
       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";
       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 +387,7 @@ if ($qs = $ENV{QUERY_STRING}) {
       "</body></html>\n";
     exit;
   }
       "</body></html>\n";
     exit;
   }

-  
+

   # ex and hopp?
   if ($qs =~ s/(^|&)DELETE//i) {
     if (unlink $data) {
   # ex and hopp?
   if ($qs =~ s/(^|&)DELETE//i) {
     if (unlink $data) {


@@ -410,12 +410,12 @@ if ($qs = $ENV{QUERY_STRING}) {
             "<h3>$filename deleted</h3>\n",
             "</body></html>\n";
       exit;
             "<h3>$filename deleted</h3>\n",
             "</body></html>\n";
       exit;

-    } else { 
+    } else {

       http_die("no such file");
     }
     exit;
       http_die("no such file");
     }
     exit;

-  } 
-  
+  }
+

   # wipe out!? (for anonymous upload)
   if ($qs =~ s/(^|&)PURGE//i) {
     $filename = filename($file);
   # wipe out!? (for anonymous upload)
   if ($qs =~ s/(^|&)PURGE//i) {
     $filename = filename($file);


@@ -434,15 +434,15 @@ if ($qs = $ENV{QUERY_STRING}) {
         print html_header($head),
           "<h3>$filename purged</h3>\n",
           "</body></html>\n";
         print html_header($head),
           "<h3>$filename purged</h3>\n",
           "</body></html>\n";

-      } else { 
+      } else {

         http_die("no such file");
       }
         http_die("no such file");
       }

-    } else { 
+    } else {

       http_die("you are not allowed to purge $filename");
     }
     exit;
       http_die("you are not allowed to purge $filename");
     }
     exit;

-  } 
-  
+  }
+

   # request for file size?
   if ($qs eq '?') {
     sendsize($file);
   # request for file size?
   if ($qs eq '?') {
     sendsize($file);


@@ -509,7 +509,7 @@ if ($range = $ENV{HTTP_RANGE}) {
 if (not $autodelete or $autodelete ne 'NO') {
   $autodelete = readlink "$file/autodelete" || 'YES';
 }
 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 = '';
 if ($from and $file eq "$from/$from/ADDRESS_BOOK") {
   if (open my $AB,'<',"$from/\@ADDRESS_BOOK") {
     my $ab = '';


@@ -550,7 +550,7 @@ 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 $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> || '';
     close $file;
   {
     $_ = <$file> || '';
     close $file;


@@ -587,14 +587,14 @@ debuglog(sprintf("%s %s %d %d %d",
          isodate(time),$file,$sb||0,$seek,-s $data||0));
 
 if ($sb+$seek == -s $data) {
          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;
   }
   # 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;
   # delete file after grace period
   if ($autodelete eq 'YES') {
     $grace_time = 60 unless defined $grace_time;


@@ -613,26 +613,26 @@ if ($sb+$seek == -s $data) {
       close $error;
     }
   }
       close $error;
     }
   }

-  
+

 }
 
 exit;
 }
 
 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 = '';
 
 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/:;
   # 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';
   $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;
   # fallback defaults, should be set later with better values
   $filename = filename($file);
   $total_size = -s $data || 0;


@@ -675,12 +675,12 @@ sub sendfile {
       }
     }
     $size = $total_size - $seek - ($stop ? $total_size-$stop-1 : 0);
       }
     }
     $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;
     $size = -s $data || 0;

-  } else { 
+  } else {

     http_die("unknown HTTP request method $ENV{REQUEST_METHOD}");
   }
     http_die("unknown HTTP request method $ENV{REQUEST_METHOD}");
   }

-  
+

   # read MIME entity header (what the client said)
   if (open $header,'<',$header) {
     while (<$header>) {
   # read MIME entity header (what the client said)
   if (open $header,'<',$header) {
     while (<$header>) {


@@ -692,9 +692,9 @@ sub sendfile {
     close $header;
     $type =~ s/\s//g;
   }
     close $header;
     $type =~ s/\s//g;
   }

-  
+

   $fileid = readlink "$file/id" || '';
   $fileid = readlink "$file/id" || '';

-  
+

   # determine own MIME entity header for download
   my $mime = $file;
   $mime =~ s:/.*:/\@MIME:;
   # determine own MIME entity header for download
   my $mime = $file;
   $mime =~ s:/.*:/\@MIME:;


@@ -717,7 +717,7 @@ sub sendfile {
   }
   # reset to default MIME type
   else { $type = 'application/octet-stream' }
   }
   # 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;
 
   # HTML is not allowed for security reasons! (embedded javascript, etc)
   $type =~ s/html/plain/i;
 


@@ -747,7 +747,7 @@ sub sendfile {
     }
     nvt_print('');
   } else {
     }
     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) {
     # http://drupal.org/node/163445
     # http://support.microsoft.com/kb/323308
     if ($http_client =~ /MSIE/ and not $nowarning) {


@@ -813,7 +813,7 @@ sub sendfile {
     # control back to fexsrv for further HTTP handling
     &reexec;
   }
     # control back to fexsrv for further HTTP handling
     &reexec;
   }

-  
+

   if ($ENV{REQUEST_METHOD} eq 'GET') {
 
     if (@throttle) {
   if ($ENV{REQUEST_METHOD} eq 'GET') {
 
     if (@throttle) {


@@ -829,7 +829,7 @@ sub sendfile {
               $bwl = $limit;
               last;
             }
               $bwl = $limit;
               last;
             }

-          } 
+          }

           # throttle e-mail address?
           else {
             # allow wildcard *, but not regexps
           # throttle e-mail address?
           else {
             # allow wildcard *, but not regexps


@@ -843,7 +843,7 @@ sub sendfile {
         }
       }
     }
         }
       }
     }

-    
+

     foreach my $sig (keys %SIG) { local $SIG{$sig} = \&sigexit }
     local $SIG{ALRM} = sub { die "TIMEOUT\n" };
 
     foreach my $sig (keys %SIG) { local $SIG{$sig} = \&sigexit }
     local $SIG{ALRM} = sub { die "TIMEOUT\n" };
 


@@ -859,7 +859,7 @@ sub sendfile {
         $b = $size-$s;
         $buf = substr($buf,0,$b)
       }
         $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) {
       alarm($timeout*10);
       syswrite STDOUT,$buf or last; # client still alive?
       if ($bwl) {


@@ -867,14 +867,14 @@ sub sendfile {
         sleep 1 while $s/(time-$t0||1)/1024 > $bwl;
       }
     }
         sleep 1 while $s/(time-$t0||1)/1024 > $bwl;
       }
     }

-    
+

     close $data;
     alarm(0);
     close $data;
     alarm(0);

-    
+

     fdlog($log,$file,$s,$size);
   }
   close $download;
     fdlog($log,$file,$s,$size);
   }
   close $download;

-  
+

   return $s;
 }
 
   return $s;
 }
 


@@ -884,13 +884,13 @@ sub sendsize {
   my ($file,$upload,$to,$from,$dkey);
   my $size = 0;
   local $_;
   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;
   $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)/;
 
   # swap to and from for special senders, see fup storage swap!
   ($from,$to) = ($to,$from) if $from =~ /^(fexmail|anonymous)/;
 


@@ -905,7 +905,7 @@ sub sendsize {
 
   if ($to eq '*' and $fileid) {
     foreach my $fd (glob "*/$from/$file") {
 
   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;
           and -l "$fd/id" and readlink "$fd/id" eq $fileid
           and $dkey = readlink "$fd/dkey") {
         $to = $fd;


@@ -929,12 +929,12 @@ sub sendsize {
     }
     close $AB;
   }
     }
     close $AB;
   }

-  
+

   if (-f "$to/$from/$file/data") {
     $dkey = readlink "$to/$from/$file/dkey";
     $fkey = slurp("$to/$from/$file/filename")||$file;
   }
   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" || '';
   $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 +1000,11 @@ sub check_auth {
 
   if ($path =~ m:(.+)/(.+)/(.+):) {
     ($to,$from,$file) = ($1,$2,$3);
 
   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);
     ($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");
   }
 
     http_die("wrong URL format for download");
   }
 


@@ -1028,15 +1028,15 @@ sub check_auth {
       debuglog("$user mismatch: id=$id, auth=$auth");
       &require_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 ':';
   # 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)) {
                or $subuser eq '*@*'
                or $subuser =~ /^\*\@(.+)/ and $user =~ /\@\Q$1\E$/i
                or $subuser =~ /(.+)\@\*$/ and $user =~ /^\Q$1\E\@/i)) {


@@ -1053,7 +1053,7 @@ sub check_auth {
     debuglog("no $to/@ and no $from/@");
     &require_auth;
   }
     debuglog("no $to/@ and no $from/@");
     &require_auth;
   }

-  
+

 }
 
 
 }
 
 


@@ -1070,7 +1070,7 @@ sub check_captive {
 sub sigexit {
   my ($sig) = @_;
   my $msg;
 sub sigexit {
   my ($sig) = @_;
   my $msg;

-  
+

   $msg = @_ ? "@_" : '???';
   $msg =~ s/\n/ /g;
   $msg =~ s/\s+$//;
   $msg = @_ ? "@_" : '???';
   $msg =~ s/\n/ /g;
   $msg =~ s/\s+$//;