Original release 20160104

[fex.git] / cgi-bin / fup

diff --git a/cgi-bin/fup b/cgi-bin/fup
index 97624a081db94e732440bc30c4ac116d63234a1d..7d222f9a3b9b14445914dc0b9e93a4f40ef72e2b 100755 (executable)
--- a/cgi-bin/fup
+++ b/cgi-bin/fup
@@ -10,6 +10,7 @@
 
 BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
 
 
 BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
 

+use utf8;

 use Encode;
 use Fcntl              qw':flock :seek :mode';
 use IO::Handle;
 use Encode;
 use Fcntl              qw':flock :seek :mode';
 use IO::Handle;


@@ -151,7 +152,7 @@ if ($from =~ /^anonymous@/ and
   $id = $rid = $anonymous = 'anonymous';
   if ($to =~ /^anonymous/) {
     @to = ($to);
   $id = $rid = $anonymous = 'anonymous';
   if ($to =~ /^anonymous/) {
     @to = ($to);

-    $autodelete{$to} = $autodelete = 'NO';
+    $autodelete{$to} = $autodelete = $specific{'autodelete'}||'NO';

   }
   $nomail = $anonymous;
 }
   }
   $nomail = $anonymous;
 }


@@ -199,10 +200,9 @@ if ($from and $id and not ($gkey or $skey or $public or $okey)) {
     # 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)) {

-      $akey = untaint(md5_hex("$from:$id"));
-      mksymlink("$akeydir/$akey","../$from");
-      # show URL from fexsend
-      if ($from eq $to and $comment eq '*') {
+      # akey for webbrowser or fexsend special
+      if (not $sid or ($from eq $to and ($comment eq '*')) or $command) {
+        $akey = untaint(md5_hex("$from:$id"));

         mksymlink("$akeydir/$akey","../$from");
       }
     }
         mksymlink("$akeydir/$akey","../$from");
       }
     }


@@ -403,14 +403,14 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
                     - int((time-mtime("$file/filename"))/$DS);
         if ($comment =~ /NOMAIL/ or
            (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) {
                     - int((time-mtime("$file/filename"))/$DS);
         if ($comment =~ /NOMAIL/ or
            (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) {

-          printf "%8s MB [%s d] %s/%s/%s\n",
+          printf "%8s MB (%2s d) %s/%s/%s\n",

                  $size,
                  $rkeep,
                  $durl,
                  $dkey,
                  urlencode(basename($file));
         } else {
                  $size,
                  $rkeep,
                  $durl,
                  $dkey,
                  urlencode(basename($file));
         } else {

-          printf "%8s MB [%s d] <a href=\"%s\">%s</a>%s %s\n",
+          printf "%8s MB (%2s d) <a href=\"%s\">%s</a>%s %s\n",

                  $size,
                  $rkeep,
                  untaint("/fup?akey=$akey&dkey=$dkey&command=RENOTIFY"),
                  $size,
                  $rkeep,
                  untaint("/fup?akey=$akey&dkey=$dkey&command=RENOTIFY"),


@@ -469,9 +469,10 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
           }
           my $rkeep = untaint(readlink "$file/keep"||$keep_default)
                       - int((time-mtime("$file/filename"))/$DS);
           }
           my $rkeep = untaint(readlink "$file/keep"||$keep_default)
                       - int((time-mtime("$file/filename"))/$DS);

-          printf "%8s MB [%s d] <a href=\"%s\">%s</a>%s\n",
+          printf "%8s MB (%2s d) %s <a href=\"%s\">%s</a>%s\n",

                  $size,
                  $rkeep,
                  $size,
                  $rkeep,

+                 stat("$file/download")?'+':'-',

                  untaint("/fup?akey=$akey&dkey=$dkey&command=FORWARD"),
                  $filename,
                  $comment?qq( "$comment"):'';
                  untaint("/fup?akey=$akey&dkey=$dkey&command=FORWARD"),
                  $filename,
                  $comment?qq( "$comment"):'';


@@ -528,7 +529,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
                    $akey,$dkey;
             printf "[<a href=\"/fup?akey=%s&dkey=%s&command=COPY\">forward</a>] ",
                    $akey,$dkey;
                    $akey,$dkey;
             printf "[<a href=\"/fup?akey=%s&dkey=%s&command=COPY\">forward</a>] ",
                    $akey,$dkey;

-            printf "%8s MB (%s d) <a href=\"%s\">%s</a>%s\n",
+            printf "%8s MB (%2s d) <a href=\"%s\">%s</a>%s\n",

                    $size,$rkeep,$url,$filename,$comment;
           }
         }
                    $size,$rkeep,$url,$filename,$comment;
           }
         }


@@ -796,7 +797,7 @@ unless ($file) {
   my @cookies;
   if ($logout and my $cookie = $ENV{HTTP_COOKIE}) {
     while ($cookie =~ s/(\w+key)=\w+//) {
   my @cookies;
   if ($logout and my $cookie = $ENV{HTTP_COOKIE}) {
     while ($cookie =~ s/(\w+key)=\w+//) {

-      push @cookies,"Set-Cookie: $1=; Max-Age=0; Discard";
+      push @cookies,"Set-Cookie: $1=x; path=/; expires=Thu, 01 Jan 1970 00:00:00 GMT";

     }
   }
 
     }
   }
 


@@ -876,7 +877,7 @@ unless ($file) {
       '  <input type="hidden" name="from" value="$from">'
       '  <input type="hidden" name="id"   value="$id">'
       '  <table border="1">'
       '  <input type="hidden" name="from" value="$from">'
       '  <input type="hidden" name="id"   value="$id">'
       '  <table border="1">'

-      '    <tr><td>sender:   <td><a href="/fup/$ab64">$from</a></tr>'
+      '    <tr><td>sender:   <td><a href="/foc">$from</a></tr>'

       '    <tr title="e-mail address or alias"><td>recipient(s):'
       '        <td><input type="text" name="to" size="96" value="$to"><br>'
     ));
       '    <tr title="e-mail address or alias"><td>recipient(s):'
       '        <td><input type="text" name="to" size="96" value="$to"><br>'
     ));


@@ -908,6 +909,11 @@ unless ($file) {
           foreach my $rd (@local_rdomains) {
             print "*\@$rd\n";
           }
           foreach my $rd (@local_rdomains) {
             print "*\@$rd\n";
           }

+        } elsif (/^\@LOCAL_USERS/) {
+          foreach (glob "*/@") {
+            s:/.::;
+            print "$_\n";
+          }

         } else {
           print "$_\n";
         }
         } else {
           print "$_\n";
         }


@@ -948,14 +954,16 @@ unless ($file) {
     pq(qq(
       '<p><hr><p>'
       '<b>'
     pq(qq(
       '<p><hr><p>'
       '<b>'

-      'Warning: the recipient must not be a mailing list, because after'
-      'download the file will be no more available!'
+      'Warning: the recipient must not be a mailing list,'
+      'because after download the file will be no more available!'

       '</b><br>'
       '</b><br>'

-      'Contact <a href="mailto:$ENV{SERVER_ADMIN}">fexmaster</a>'
-      'if you want to fex to a mailing list,'
+      'Contact <a href="mailto:$ENV{SERVER_ADMIN}">fexmaster</a> if you want to fex to a mailing list,'

       'he can allow multiple downloads for specific addresses.'
       'he can allow multiple downloads for specific addresses.'

+      '<p>'
+      'Use a <a href="/tools.html">F*EX client</a> if you want to send more than one file or resume an interrupted upload.'

       '</body></html>'
       '</body></html>'

-    ));
+      '<p>
+   ));

     exit;
   }
 
     exit;
   }
 


@@ -1052,7 +1060,7 @@ unless ($file) {
       pq(qq(
         '  <input type="hidden" name="akey" value="$akey">'
         '  <table border="1">'
       pq(qq(
         '  <input type="hidden" name="akey" value="$akey">'
         '  <table border="1">'

-        '    <tr><td>sender:<td>$from</tr>'
+        '    <tr><td>sender:<td><a href="/foc">$from</a></tr>'

       ));
       if ($anonymous) {
         pq(qq(
       ));
       if ($anonymous) {
         pq(qq(


@@ -1185,7 +1193,7 @@ unless ($file) {
   pq(qq(
     '<form action="/fup"'
     '      method="post"'
   pq(qq(
     '<form action="/fup"'
     '      method="post"'

-    '      accept-charset="ISO-8859-1"'
+    '      accept-charset="UTF-8"'

     '      enctype="multipart/form-data">'
     '  <table>'
     '    <tr><td>sender:'
     '      enctype="multipart/form-data">'
     '  <table>'
     '    <tr><td>sender:'


@@ -1538,11 +1546,18 @@ sub parse_request {
   # parse HTTP QUERY_STRING (parameter=value pairs)
   if ($qs) {
     foreach (split '&',$qs) {
   # parse HTTP QUERY_STRING (parameter=value pairs)
   if ($qs) {
     foreach (split '&',$qs) {

-      if (s/^(\w+)=//) {
-        my $x = $1;
+      if (s/^(\w+)=(.*)//) {
+        my $p = uc($1);
+        my $v = $2;

         # decode URL-encoding
         # decode URL-encoding

-        s/%([a-f0-9]{2})/chr(hex($1))/gie;
-        setparam($x,$_);
+        $v =~ s/%([a-f0-9]{2})/chr(hex($1))/gie;
+        setparam($p,$v);
+        if ($p eq 'AUTODELETE') {
+          $specific{'autodelete'} = $autodelete = $v;
+        }
+        if ($p eq 'KEEP' and /^\d+$/) {
+          $specific{'keep'} = $keep = $v;
+        }

       }
     }
   }
       }
     }
   }


@@ -1680,9 +1695,9 @@ sub parse_request {
           foreach my $address (split(",",$address)) {
             $address .= '@'.$mdomain if $mdomain and $address !~ /@/;
             push @{$ab{$alias}},$address;
           foreach my $address (split(",",$address)) {
             $address .= '@'.$mdomain if $mdomain and $address !~ /@/;
             push @{$ab{$alias}},$address;

-            $autodelete{$alias} = $autodelete;
-            $keep{$alias}       = $keep;
-            $locale{$alias}     = $locale;
+            $autodelete{$alias} = $autodelete if $autodelete;
+            $keep{$alias}       = $keep       if $keep;
+            $locale{$alias}     = $locale     if $locale;

           }
         }
       }
           }
         }
       }


@@ -1710,7 +1725,7 @@ sub parse_request {
           } elsif ($locale{$to}) {
             $locale{$address} = $locale{$to};
           } else {
           } elsif ($locale{$to}) {
             $locale{$address} = $locale{$to};
           } else {

-            $locale{$address} = $locale ;
+            $locale{$address} = $::locale ;

           }
           unless ($locale{$address}) {
             $locale{$address} = $default_locale || 'english';
           }
           unless ($locale{$address}) {
             $locale{$address} = $default_locale || 'english';


@@ -2056,7 +2071,7 @@ sub get_file {
 
       if ($from eq "@to") {
         # special "fex yourself"
 
       if ($from eq "@to") {
         # special "fex yourself"

-        mksymlink("$filed/autodelete",'NO');
+        mksymlink("$filed/autodelete",$specific{'autodelete'}||'NO');

       } else {
         $autodelete{$to} = $autodelete unless $autodelete{$to};
         if ($autodelete{$to} =~ /^(DELAY|NO|\d+)$/i) {
       } else {
         $autodelete{$to} = $autodelete unless $autodelete{$to};
         if ($autodelete{$to} =~ /^(DELAY|NO|\d+)$/i) {


@@ -2320,6 +2335,9 @@ sub check_rr {
             $ar .= '|[^\@]+\@' . $rd;
           }
           $ar .= ')';
             $ar .= '|[^\@]+\@' . $rd;
           }
           $ar .= ')';

+        } elsif (/^\@LOCAL_USERS/ and -s "$to/@") {
+          $allowed = 1;
+          last;

         } else {
           # allow wildcard *, but not regexps
           $ar = quotemeta $_;
         } else {
           # allow wildcard *, but not regexps
           $ar = quotemeta $_;


@@ -2375,11 +2393,14 @@ sub expand {
 sub forward {
   my $file = shift;
   my ($nfile,$to,$AB);
 sub forward {
   my $file = shift;
   my ($nfile,$to,$AB);

-  my ($filename);
+  my ($filename,$keep);

   my (%to);
 
   http_die("no file data for <code>$file</code>") unless -f "$file/data";
 
   my (%to);
 
   http_die("no file data for <code>$file</code>") unless -f "$file/data";
 

+  $keep = $::keep||$keep_default;
+  if (my $mt = mtime("$file/data")) { $keep += int((time-$mt)/$DS) }
+

   if (@to) {
 
     # check recipients restriction
   if (@to) {
 
     # check recipients restriction


@@ -2413,11 +2434,11 @@ sub forward {
       }
     }
 
       }
     }
 

+    @to = keys %to;
+    

     http_header('200 OK');
     print html_header($head);
 
     http_header('200 OK');
     print html_header($head);
 

-    @to = keys %to;
-

     foreach my $to (my @loop = @to) {
       $to =~ s/:\w+=.*//; # remove options from address
       $nfile = $file;
     foreach my $to (my @loop = @to) {
       $to =~ s/:\w+=.*//; # remove options from address
       $nfile = $file;


@@ -2444,15 +2465,15 @@ sub forward {
         close $comment;
       }
       if ($autodelete =~ /^(DELAY|NO|\d+)$/i) {
         close $comment;
       }
       if ($autodelete =~ /^(DELAY|NO|\d+)$/i) {

-        symlink($autodelete,"$nfile/autodelete");
-      }
-      symlink($keep||$keep_default,         "$nfile/keep");
-                    copy("$file/id",        "$nfile/id");
-                    copy("$file/ip",        "$nfile/ip");
-                    copy("$file/speed",     "$nfile/speed");
-                    copy("$file/replyto",   "$nfile/replyto");
-      $filename   = copy("$file/filename",  "$nfile/filename");
-      link               "$file/data",      "$nfile/data"
+        symlink $autodelete,"$nfile/autodelete";
+      }
+      symlink          $keep,             "$nfile/keep";
+                  copy("$file/id",        "$nfile/id");
+                  copy("$file/ip",        "$nfile/ip");
+                  copy("$file/speed",     "$nfile/speed");
+                  copy("$file/replyto",   "$nfile/replyto");
+      $filename = copy("$file/filename",  "$nfile/filename");
+      link             "$file/data",      "$nfile/data"

         or die http_die("cannot create $nfile/data - $!");
       unless ($dkey = readlink("$nfile/dkey") and -l "$dkeydir/$dkey") {
         $dkey = randstring(8);
         or die http_die("cannot create $nfile/data - $!");
       unless ($dkey = readlink("$nfile/dkey") and -l "$dkeydir/$dkey") {
         $dkey = randstring(8);


@@ -2622,6 +2643,7 @@ sub setparam {
   } elsif ($v eq 'FEXYOURSELF') {
     $submit = $vv;
     @to = ($from);
   } elsif ($v eq 'FEXYOURSELF') {
     $submit = $vv;
     @to = ($from);

+    $specific{'autodelete'} = $autodelete = 'no';

   } elsif ($v eq 'TO') {
     # extract AUTODELETE and KEEP options
     if ($vv =~ s/[\s,]+AUTODELETE=(\w+)//i) {
   } elsif ($v eq 'TO') {
     # extract AUTODELETE and KEEP options
     if ($vv =~ s/[\s,]+AUTODELETE=(\w+)//i) {


@@ -2637,9 +2659,15 @@ sub setparam {
     if ($from) {
       if ($to eq '.') {
         $to = $from;
     if ($from) {
       if ($to eq '.') {
         $to = $from;

+         unless ($specific{'autodelete'}) {
+           $specific{'autodelete'} = $autodelete = 'no';
+         }

       }
       if ($to eq '//') {
         $to = $from;
       }
       if ($to eq '//') {
         $to = $from;

+        unless ($specific{'autodelete'}) {
+          $specific{'autodelete'} = $autodelete = 'no';
+        }

         $comment = '//';
       }
     }
         $comment = '//';
       }
     }