]> git.treefish.org Git - fex.git/blobdiff - lib/fex.pp
Original release 20160328
[fex.git] / lib / fex.pp
index bb72a4ea37e673abc3037b9561834f4e9edc5ca0..8bfddbf550276afad07c019c7c35b6820cd168f5 100644 (file)
@@ -1,6 +1,7 @@
 #  -*- perl -*-
 
 use 5.008;
+use utf8;
 use Fcntl              qw':flock :seek :mode';
 use IO::Handle;
 use IPC::Open3;
@@ -13,7 +14,7 @@ use Symbol            qw'gensym';
 # set and untaint ENV if not in CLI (fexsrv provides clean ENV)
 unless (-t) {
   foreach my $v (keys %ENV) {
-    ($ENV{$v}) = ($ENV{$v} =~ /(.*)/s);
+    ($ENV{$v}) = ($ENV{$v} =~ /(.*)/s) if defined $ENV{$v};
   }
   $ENV{PATH}     = '/usr/local/bin:/bin:/usr/bin';
   $ENV{IFS}      = " \t\n";
@@ -43,11 +44,14 @@ $logdir = $spooldir;
 $autodelete = 'YES';
 $overwrite = 'YES';
 $limited_download = 'YES';     # multiple downloads only from same client
+$fex_yourself = 'YES';         # allow SENDER = RECIPIENT
 $keep = 5;                     # days
 $recipient_quota = 0;          # MB
 $sender_quota = 0;             # MB
 $timeout = 30;                 # seconds
 $bs = 2**16;                   # I/O blocksize
+$DS = 60*60*24;                        # seconds in a day
+$MB = 1024*1024;               # binary Mega
 $use_cookies = 1;
 $sendmail = '/usr/lib/sendmail';
 $sendmail = '/usr/sbin/sendmail' unless -x $sendmail;
@@ -59,6 +63,17 @@ $mail_authid = 'yes';
 $force_https = 0;
 $debug = 0;
 
+# https://securityheaders.io/
+# https://scotthelme.co.uk/hardening-your-http-response-headers/
+# http://content-security-policy.com/
+@extra_header = (
+  # "Content-Security-Policy: sandbox allow-forms allow-scripts",
+  "Content-Security-Policy: script-src 'self' 'unsafe-inline'",
+  "X-Frame-Options: SAMEORIGIN",
+  "X-XSS-Protection: 1; mode=block",
+  "X-Content-Type-Options: nosniff",
+);
+
 $FHS = -f '/etc/fex/fex.ph' and -d '/usr/share/fex/lib';
 # Debian FHS
 if ($FHS) {
@@ -68,13 +83,10 @@ if ($FHS) {
   $docdir = '/var/lib/fex/htdocs';
   $notify_newrelease = '';
 }
-  
+
 # allowed download managers (HTTP User-Agent)
 $adlm = '^(Axel|fex)';
 
-# allowed multi download recipients
-$amdl = '^(anonymous|_fexmail_)';
-
 # local config
 require "$FEXLIB/fex.ph" or die "$0: cannot load $FEXLIB/fex.ph - $!";
 
@@ -82,10 +94,22 @@ $fop_auth   = 0 if $fop_auth        =~ /no/i;
 $mail_authid   = 0 if $mail_authid     =~ /no/i;
 $force_https   = 0 if $force_https     =~ /no/i;
 $debug         = 0 if $debug           =~ /no/i;
-  
+
+@logdir = ($logdir) unless @logdir;
+$logdir = $logdir[0];
+
+# allowed multi download recipients: from any ip, any times
+if (@mailing_lists) {
+  $amdl = '^('.join('|',map { quotewild($_) } @mailing_lists).')$';
+} else {
+  $amdl = '^-$';
+}
+
 # check for name based virtual host
 $vhost = vhost($ENV{'HTTP_HOST'});
 
+$RB = 0; # read POST bytes
+
 push @doc_dirs,$docdir;
 foreach my $ld (glob "$FEXHOME/locale/*/htdocs") {
   push @doc_dirs,$ld;
@@ -94,7 +118,7 @@ foreach my $ld (glob "$FEXHOME/locale/*/htdocs") {
 $nomail = ($mailmode =~ /^MANUAL|nomail$/i);
 
 if (not $nomail and not -x $sendmail) {
-  http_die("found no sendmail\n");
+  http_die("found no sendmail");
 }
 http_die("cannot determine the server hostname") unless $hostname;
 
@@ -102,14 +126,14 @@ $ENV{PROTO} = 'http' unless $ENV{PROTO};
 $keep = $keep_default ||= $keep || 5;
 $fra = $ENV{REMOTE_ADDR} || '';
 $sid = $ENV{SID} || '';
-  
-mkdirp($dkeydir = "$spooldir/.dkeys"); # download keys
-mkdirp($ukeydir = "$spooldir/.ukeys"); # upload keys
-mkdirp($akeydir = "$spooldir/.akeys"); # authentification keys
-mkdirp($skeydir = "$spooldir/.skeys"); # subuser authentification keys
-mkdirp($gkeydir = "$spooldir/.gkeys"); # group authentification keys
-mkdirp($xkeydir = "$spooldir/.xkeys"); # extra download keys
-mkdirp($lockdir = "$spooldir/.locks"); # download lock files
+
+$dkeydir = "$spooldir/.dkeys"; # download keys
+$ukeydir = "$spooldir/.ukeys"; # upload keys
+$akeydir = "$spooldir/.akeys"; # authentification keys
+$skeydir = "$spooldir/.skeys"; # subuser authentification keys
+$gkeydir = "$spooldir/.gkeys"; # group authentification keys
+$xkeydir = "$spooldir/.xkeys"; # extra download keys
+$lockdir = "$spooldir/.locks"; # download lock files
 
 if (my $ra = $ENV{REMOTE_ADDR} and $max_fail) {
   mkdirp("$spooldir/.fail");
@@ -143,16 +167,41 @@ if (@locales) {
 
 $default_locale ||= 'english';
 
+# $durl is first default fop download URL
+# @durl is optional mandatory fop download URL list (from fex.ph)
 unless ($durl) {
   my $host = '';
-  my $port = 0;
-  
-  ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
-  $host = $hostname;
-  
-  unless ($port) {
-    $port = 80;
-    if (open my $xinetd,'<',"/etc/xinetd.d/fex") {
+  my $port = 80;
+  my $xinetd = '/etc/xinetd.d/fex';
+
+  if (@durl) {
+    $durl = $durl[0];
+  } elsif ($ENV{HTTP_HOST} and $ENV{PROTO}) {
+
+    ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
+    $host = $hostname;
+
+    unless ($port) {
+      $port = 80;
+      if (open $xinetd,$xinetd) {
+        while (<$xinetd>) {
+          if (/^\s*port\s*=\s*(\d+)/) {
+            $port = $1;
+            last;
+          }
+        }
+        close $xinetd;
+      }
+    }
+
+    # use same protocal as uploader for download
+    if ($ENV{PROTO} eq 'https' and $port == 443 or $port == 80) {
+      $durl = "$ENV{PROTO}://$host/fop";
+    } else {
+      $durl = "$ENV{PROTO}://$host:$port/fop";
+    }
+  } else {
+    if (open $xinetd,$xinetd) {
       while (<$xinetd>) {
         if (/^\s*port\s*=\s*(\d+)/) {
           $port = $1;
@@ -161,16 +210,13 @@ unless ($durl) {
       }
       close $xinetd;
     }
-  }
-  
-  # use same protocal as uploader for download
-  if ($ENV{PROTO} eq 'https' and $port == 443 or $port == 80) {
-    $durl = "$ENV{PROTO}://$host/fop";
-  } else {
-    $durl = "$ENV{PROTO}://$host:$port/fop";
+    if ($port == 80) {
+      $durl = "http://$hostname/fop";
+    } else {
+      $durl = "http://$hostname:$port/fop";
+    }
   }
 }
-
 @durl = ($durl) unless @durl;
 
 
@@ -183,7 +229,7 @@ sub reexec {
 sub jsredirect {
   $url = shift;
   $cont = shift || 'request accepted: continue';
-  
+
   http_header('200 ok');
   print html_header($head||$ENV{SERVER_NAME});
   pq(qq(
@@ -216,24 +262,24 @@ sub nvt_print {
 
 sub html_quote {
   local $_ = shift;
-  
+
   s/&/&amp;/g;
   s/</&lt;/g;
   s/\"/&quot;/g;
-  
+
   return $_;
 }
 
 
 
 sub http_header {
-  
+
   my $status = shift;
   my $msg = $status;
 
   return if $HTTP_HEADER;
   $HTTP_HEADER = $status;
-  
+
   $msg =~ s/^\d+\s*//;
 
   nvt_print("HTTP/1.1 $status");
@@ -242,15 +288,16 @@ sub http_header {
   nvt_print("Server: fexsrv");
   nvt_print("Expires: 0");
   nvt_print("Cache-Control: no-cache");
-  # http://en.wikipedia.org/wiki/Clickjacking
-  nvt_print("X-Frame-Options: SAMEORIGIN");
   if ($force_https) {
     # https://www.owasp.org/index.php/HTTP_Strict_Transport_Security
-    nvt_print("Strict-Transport-Security: max-age=2851200");
+    # https://scotthelme.co.uk/hsts-the-missing-link-in-tls/
+    nvt_print("Strict-Transport-Security: max-age=2851200; preload");
   }
+  nvt_print($_) foreach(@extra_header);
   if ($use_cookies) {
+    $akey = md5_hex("$from:$id") if $id and $from;
     if ($akey) {
-      nvt_print("Set-Cookie: akey=$akey; Max-Age=9999; Discard");
+      nvt_print("Set-Cookie: akey=$akey; path=/; Max-Age=9999; Discard");
     }
     # if ($skey) {
     #   nvt_print("Set-Cookie: skey=$skey; Max-Age=9999; Discard");
@@ -284,19 +331,19 @@ sub html_header {
     '</head>'
   ));
   # '<!-- <style type="text/css">\@import "/fex.css";</style> -->'
-  
-  if ($0 =~ /fexdev/) { $head .= "<body bgcolor=\"pink\">\n" } 
+
+  if ($0 =~ /fexdev/) { $head .= "<body bgcolor=\"pink\">\n" }
   else                { $head .= "<body>\n" }
-  
+
   $title =~ s:F\*EX:<a href="/index.html">F*EX</a>:;
 
   if (open $header,'<',"$docdir/$header") {
     $head .= $_ while <$header>;
     close $header;
   }
-  
+
   $head .= &$prolog($title) if defined($prolog);
-  
+
   if (@H1_extra) {
     $head .= sprintf(
       '<h1><a href="%s"><img align=center src="%s" border=0></a>%s</h1>',
@@ -306,7 +353,7 @@ sub html_header {
     $head .= "<h1>$title</h1>";
   }
   $head .= "\n";
-  
+
   return $head;
 }
 
@@ -316,14 +363,14 @@ sub html_error {
   my $msg = "@_";
   my @msg = @_;
   my $isodate = isodate(time);
-  
+
   $msg =~ s/[\s\n]+/ /g;
   $msg =~ s/<.+?>//g; # remove HTML
   map { s/<script.*?>//gi } @msg;
-  
+
   errorlog($msg);
-  
-  # cannot send standard HTTP Status-Code 400, because stupid 
+
+  # cannot send standard HTTP Status-Code 400, because stupid
   # Internet Explorer then refuses to display HTML body!
   http_header("666 Bad Request - $msg");
   print html_header($error);
@@ -342,12 +389,15 @@ sub html_error {
 
 
 sub http_die {
-  
+
   # not in CGI mode
-  die "$0: @_\n" unless $ENV{GATEWAY_INTERFACE};
-  
+  unless ($ENV{GATEWAY_INTERFACE}) {
+    warn "$0: @_\n"; # must not die, because of fex_cleanup!
+    return;
+  }
+
   debuglog(@_);
-  
+
   # create special error file on upload
   if ($uid) {
     my $ukey = "$spooldir/.ukeys/$uid";
@@ -358,7 +408,7 @@ sub http_die {
       close $ukey;
     }
   }
-  
+
   html_error($error||'',@_);
 }
 
@@ -384,7 +434,7 @@ sub check_maint {
 
 sub check_status {
   my $user = shift;
-  
+
   $user = lc $user;
   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 
@@ -415,7 +465,7 @@ sub encode_Q {
   my $s = shift;
   $s =~ s{([\=\x00-\x20\x7F-\xA0])}{sprintf("=%02X",ord($1))}eog;
   return $s;
-}  
+}
 
 
 # from MIME::Base64::Perl
@@ -442,13 +492,13 @@ sub decode_b64 {
 sub b64 {
   local $_ = '';
   my $x = 0;
-  
+
   pos($_[0]) = 0;
   $_ = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
   tr|` -_|AA-Za-z0-9+/|;
   $x = (3 - length($_[0]) % 3) % 3;
   s/.{$x}$//;
-  
+
   return $_;
 }
 
@@ -461,7 +511,7 @@ sub rmrf {
   my ($file,$dir);
   local *D;
   local $_;
-  
+
   foreach (@files) {
     next if /(^|\/)\.\.$/;
     /(.*)/; $file = $1;
@@ -507,7 +557,7 @@ sub gethostname {
   if ($hostname !~ /\./ and $admin and $admin =~ /\@([\w.-]+)/) {
     $hostname .= '.'.$1;
   }
-  
+
   return $hostname;
 }
 
@@ -515,10 +565,10 @@ sub gethostname {
 # strip off path names (Windows or UNIX)
 sub strip_path {
   local $_ = shift;
-  
+
   s/.*\\// if /^([A-Z]:)?\\/;
   s:.*/::;
-  
+
   return $_;
 }
 
@@ -526,9 +576,9 @@ sub strip_path {
 # substitute all critcal chars
 sub normalize {
   local $_ = shift;
-  
+
   return '' unless defined $_;
-  
+
   # we need perl native utf8 (see perldoc utf8)
   $_ = decode_utf8($_) unless utf8::is_utf8($_);
 
@@ -536,7 +586,7 @@ sub normalize {
   s/[\x00-\x1F\x80-\x9F]/_/g;
   s/^\s+//;
   s/\s+$//;
-  
+
   return encode_utf8($_);
 }
 
@@ -544,12 +594,12 @@ sub normalize {
 # substitute all critcal chars
 sub normalize_html {
   local $_ = shift;
-  
+
   return '' unless defined $_;
-  
+
   $_ = normalize($_);
   s/[\"<>]//g;
-  
+
   return $_;
 }
 
@@ -563,20 +613,20 @@ sub normalize_filename {
 
   # we need native utf8
   $_ = decode_utf8($_) unless utf8::is_utf8($_);
+
   $_ = strip_path($_);
-  
+
   # substitute all critcal chars with underscore
   s/[^a-zA-Z0-9_=.+-]/_/g;
   s/^\./_/;
-  
+
   return encode_utf8($_);
 }
 
 
 sub normalize_email {
   local $_ = lc shift;
-  
+
   s/[^\w_.+=!~#^\@\-]//g;
   s/^\./_/;
   /(.*)/;
@@ -584,6 +634,23 @@ sub normalize_email {
 }
 
 
+sub normalize_user {
+  my $user = shift;
+
+  $user = lc(urldecode(despace($user)));
+  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
+  checkaddress($user) or http_die("$user is not a valid e-mail address");
+  return untaint($user);
+}
+
+
+sub urldecode {
+  local $_ = shift;
+  s/%([a-f0-9]{2})/chr(hex($1))/gie;
+  return $_;
+}
+
+
 sub untaint {
   local $_ = shift;
   /(.*)/s;
@@ -594,7 +661,7 @@ sub untaint {
 sub checkchars {
   my $input = shift;
   local $_ = shift;
-  
+
   if (/^([|+.])/) {
     http_die("\"$1\" is not allowed at beginning of $input");
   }
@@ -617,12 +684,14 @@ sub checkaddress {
   my $re;
   local $_;
   local ($domain,$dns);
-  
+
   $a =~ s/:\w+=.*//; # remove options from address
-  
+
   return $a if $a eq 'anonymous';
-  
-  $re = '^[.@]|@.*@|local(host|domain)$|["\'\`\|\s()<>/;,]';
+
+  $a .= '@'.$mdomain if $mdomain and $a !~ /@/;
+
+  $re = '^[.@-]|@.*@|local(host|domain)$|["\'\`\|\s()<>/;,]';
   if ($a =~ /$re/i) {
     debuglog("$a has illegal syntax ($re)");
     return '';
@@ -630,7 +699,7 @@ sub checkaddress {
   $re = '^[!^=~#_:.+*{}\w\-\[\]]+\@(\w[.\w\-]*\.[a-z]+)$';
   if ($a =~ /$re/i) {
     $domain = $dns = $1;
-    { 
+    {
       local $SIG{__DIE__} = sub { die "\n" };
       eval q{
         use Net::DNS;
@@ -638,7 +707,7 @@ sub checkaddress {
         unless ($dns or mx('uni-stuttgart.de')) {
           http_die("Internal error: bad resolver");
         }
-      } 
+      }
     };
     if ($dns) {
       return untaint($a);
@@ -663,8 +732,7 @@ sub checkforbidden {
   return $a if -d "$spooldir/$a"; # ok, if user already exists
   if (@forbidden_recipients) {
     foreach (@forbidden_recipients) {
-      $fr = quotemeta;
-      $fr =~ s/\\\*/.*/g; # allow wildcard *
+      $fr = quotewild($_);
       # skip public recipients
       if (@public_recipients) {
         foreach $pr (@public_recipients) {
@@ -680,10 +748,10 @@ sub checkforbidden {
 
 sub randstring {
   my $n = shift;
-  my @rc = ('A'..'Z','a'..'z',0..9 ); 
-  my $rn = @rc; 
+  my @rc = ('A'..'Z','a'..'z',0..9 );
+  my $rn = @rc;
   my $rs;
-  
+
   for (1..$n) { $rs .= $rc[int(rand($rn))] };
   return $rs;
 }
@@ -693,16 +761,16 @@ sub randstring {
 sub mkdirp {
   my $dir = shift;
   my $pdir;
-  
+
   return if -d $dir;
   $dir =~ s:/+$::;
-  http_die("cannot mkdir /\n") unless $dir;
+  http_die("cannot mkdir /") unless $dir;
   $pdir = $dir;
   if ($pdir =~ s:/[^/]+$::) {
     mkdirp($pdir) unless -d $pdir;
   }
   unless (-d $dir) {
-    mkdir $dir,0770 or http_die("mkdir $dir - $!\n");
+    mkdir $dir,0770 or http_die("mkdir $dir - $!");
   }
 }
 
@@ -726,7 +794,7 @@ sub ipin {
 
   $ipe = lc(ipe($ip));
   map { lc } @list;
-  
+
   foreach $i (@list) {
     if ($ip =~ /\./ and $i =~ /\./ or $ip =~ /:/ and $i =~ /:/) {
       if ($i =~ /(.+)-(.+)/) {
@@ -769,12 +837,12 @@ sub filename {
     chomp $filename;
     close $file;
   }
-  
+
   unless ($filename) {
     $filename = $file;
     $filename =~ s:.*/::;
   }
-  
+
   return $filename;
 }
 
@@ -789,20 +857,16 @@ sub urlencode {
 # file and document log
 sub fdlog {
   my ($log,$file,$s,$size) = @_;
-  my $ra;
-  
-  if (open $log,'>>',$log) {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    $ra = $ENV{REMOTE_ADDR}||'-';
-    $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
-    $ra =~ s/\s//g;
-    $file =~ s:/data$::;
-    printf {$log} 
-           "%s [%s_%s] %s %s %s/%s\n",
-           isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file),$s,$size;
-    close $log;
-  }
+  my $ra = $ENV{REMOTE_ADDR}||'-';
+  my $msg;
+
+  $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
+  $ra =~ s/\s//g;
+  $file =~ s:/data$::;
+  $msg = sprintf "%s [%s_%s] %s %s %s/%s\n",
+         isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file),$s,$size;
+
+  writelog($log,$msg);
 }
 
 
@@ -810,21 +874,25 @@ sub fdlog {
 sub debuglog {
   my $prg = $0;
   local $_;
-  
+
   return unless $debug and @_;
   unless ($debuglog and fileno $debuglog) {
-    mkdir "$logdir/.debug",0770 unless -d "$logdir/.debug";
+    my $ddir = "$spooldir/.debug";
+    mkdir $ddir,0770 unless -d $ddir;
     $prg =~ s:.*/::;
     $prg = untaint($prg);
-    $debuglog = sprintf("%s/.debug/%s_%s_%s.%s",
-                        $logdir,time,$$,$ENV{REQUESTCOUNT}||0,$prg);
+    $debuglog = sprintf("%s/%s_%s_%s.%s",
+                        $ddir,time,$$,$ENV{REQUESTCOUNT}||0,$prg);
     $debuglog =~ s/\s/_/g;
+    # http://perldoc.perl.org/perlunifaq.html#What-is-a-%22wide-character%22%3f
     # open $debuglog,'>>:encoding(UTF-8)',$debuglog or return;
     open $debuglog,'>>',$debuglog or return;
+    # binmode($debuglog,":utf8");
     autoflush $debuglog 1;
     # printf {$debuglog} "\n### %s ###\n",isodate(time);
   }
   while ($_ = shift @_) {
+    $_ = encode_utf8($_) if utf8::is_utf8($_);
     s/\n*$/\n/;
     s/<.+?>//g; # remove HTML
     print {$debuglog} $_;
@@ -836,22 +904,32 @@ sub debuglog {
 # extra debug log
 sub errorlog {
   my $prg = $0;
-  my $log = "$logdir/error.log";
   my $msg = "@_";
+  my $ra = $ENV{REMOTE_ADDR}||'-';
 
+  $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
+  $ra =~ s/\s//g;
   $prg =~ s:.*/::;
   $msg =~ s/[\r\n]+$//;
   $msg =~ s/[\r\n]+/ /;
   $msg =~ s/\s*<p>.*//;
+  $msg = sprintf "%s %s %s %s\n",isodate(time),$prg,$ra,$msg;
+
+  writelog('error.log',$msg);
+}
+
+
+sub writelog {
+  my $log = shift;
+  my $msg = shift;
 
-  if (open $log,'>>',$log) {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    $ra = $ENV{REMOTE_ADDR}||'-';
-    $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
-    $ra =~ s/\s//g;
-    printf {$log} "%s %s %s %s\n",isodate(time),$prg,$ra,$msg;
-    close $log;
+  foreach my $logdir (@logdir) {
+    if (open $log,'>>',"$logdir/$log") {
+      flock $log,LOCK_EX;
+      seek $log,0,SEEK_END;
+      print {$log} $msg;
+      close $log;
+    }
   }
 }
 
@@ -886,11 +964,11 @@ sub qqq {
   my $q = "[\'\"]"; # quote delimiter chars " and '
 
   # remove first newline and look for default indention
-  s/^((\d+)?)?\n//;
+  s/^((\d+)?)?\n//;
   $i = ' ' x ($2||0);
 
   # remove trailing spaces at end
-  s/[ \t]*?$//;
+  s/[ \t]*?$//;
 
   @s = split "\n";
 
@@ -921,7 +999,9 @@ sub qqq {
 # print superquoted
 sub pq {
   my $H = STDOUT;
+
   if (@_ > 1 and defined fileno $_[0]) { $H = shift }
+  binmode($H,':utf8');
   print {$H} qqq(@_);
 }
 
@@ -931,9 +1011,9 @@ sub check_sender_quota {
   my $sender = shift;
   my $squota = $sender_quota||0;
   my $du = 0;
-  my ($file,$size,%file,$data);
+  my ($file,$size,%file,$data,$upload);
   local $_;
-  
+
   if (open $qf,'<',"$sender/\@QUOTA") {
     while (<$qf>) {
       s/#.*//;
@@ -941,9 +1021,10 @@ sub check_sender_quota {
     }
     close $qf;
   }
-  
+
   foreach $file (glob "*/$sender/*") {
     $data = "$file/data";
+    $upload = "$file/upload";
     if (not -l $data and $size = -s $data) {
       # count hard links only once (= same inode)
       my $i = (stat($data))[1]||0;
@@ -951,11 +1032,16 @@ sub check_sender_quota {
         $du += $size;
         $file{$i} = $i;
       }
-    } elsif (-f "$file/upload" and $size = readlink "$file/size") {
-      $du += $size;
+    } elsif (-f $upload) {
+      # count hard links only once (= same inode)
+      my $i = (stat($upload))[1]||0;
+      unless ($file{$i}) {
+        $size = readlink "$file/size" and $du += $size;
+        $file{$i} = $i;
+      }
     }
   }
-  
+
   return($squota,int($du/1024/1024));
 }
 
@@ -967,7 +1053,7 @@ sub check_recipient_quota {
   my $du = 0;
   my ($file,$size);
   local $_;
-  
+
   if (open my $qf,'<',"$recipient/\@QUOTA") {
     while (<$qf>) {
       s/#.*//;
@@ -975,7 +1061,7 @@ sub check_recipient_quota {
     }
     close $qf;
   }
-  
+
   foreach $file (glob "$recipient/*/*") {
     if (-f "$file/upload" and $size = readlink "$file/size") {
       $du += $size;
@@ -983,7 +1069,7 @@ sub check_recipient_quota {
       $du += $size;
     }
   }
-  
+
   return($rquota,int($du/1024/1024));
 }
 
@@ -1000,7 +1086,7 @@ sub getline {
 sub wcmatch {
   local $_ = shift;
   my $p = quotemeta shift;
-  
+
   $p =~ s/\\\*/.*/g;
   $p =~ s/\\\?/./g;
   $p =~ s/\\\[/[/g;
@@ -1009,7 +1095,7 @@ sub wcmatch {
   return /$p/;
 }
 
-  
+
 sub logout {
   my $logout;
   if    ($skey) { $logout = "/fup?logout=skey:$skey" }
@@ -1029,7 +1115,7 @@ sub logout {
 # print data dump of global or local variables in HTML
 # input musst be a string, eg: '%ENV'
 sub DD {
-  my $v = shift; 
+  my $v = shift;
   local $_;
 
   $n =~ s/.//;
@@ -1039,7 +1125,7 @@ sub DD {
   s/</&lt;/g;
   print "<pre>\n$_\n</pre>\n";
 }
-  
+
 # make symlink
 sub mksymlink {
   my ($file,$link) = @_;
@@ -1056,7 +1142,7 @@ sub copy {
   my $link;
   local $/;
   local $_;
-  
+
   $to .= '/'.basename($from) if -d $to;
 
   if (defined($link = readlink $from)) {
@@ -1070,7 +1156,7 @@ sub copy {
     eval $mod if $mod;
     print {$to} $_;
     close $to or http_die("internal error: $to - $!");
-    if (my @s = stat($from)) { 
+    if (my @s = stat($from)) {
       chmod $s[2],$to;
       utime @s[8,9],$to unless $mod;
     }
@@ -1084,7 +1170,7 @@ sub slurp {
   my $file = shift;
   local $_;
   local $/;
-  
+
   if (open $file,$file) {
     $_ = <$file>;
     close $file;
@@ -1094,6 +1180,91 @@ sub slurp {
 }
 
 
+# read one line from STDIN (net socket) and assign it to $_
+# return number of read bytes
+# also set global variable $RB (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/ }
+}
+
+
+# HTTP GET and POST parameters
+# (not used by fup)
+# fills global variable %PARAM :
+# normal parameter is $PARAM{$parameter}
+# file parameter is $PARAM{$parameter}{filename} $PARAM{$parameter}{data}
+sub parse_parameters {
+  my $cl = $ENV{X_CONTENT_LENGTH} || $ENV{CONTENT_LENGTH} || 0;
+  my $data = '';
+  my $filename;
+  local $_;
+
+  if ($cl > 128*$MB) {
+    http_die("request too large");
+  }
+
+  binmode(STDIN,':raw');
+
+  foreach (split('&',$ENV{QUERY_STRING})) {
+    if (/(.+?)=(.*)/) { $PARAM{$1} = $2 }
+    else              { $PARAM{$_} = $_ }
+  }
+  $_ = $ENV{CONTENT_TYPE}||'';
+  if ($ENV{REQUEST_METHOD} eq 'POST' and /boundary=\"?([\w\-\+\/_]+)/) {
+    my $boundary = $1;
+    while ($RB<$cl and &nvt_read) { last if /^--\Q$boundary/ }
+    # continuation lines are not checked!
+    while ($RB<$cl and &nvt_read) {
+      $filename = '';
+      if (/^Content-Disposition:.*\s*filename="(.+?)"/i) {
+        $filename = $1;
+      }
+      if (/^Content-Disposition:\s*form-data;\s*name="(.+?)"/i) {
+        my $p = $1;
+        # skip rest of mime part header
+        while ($RB<$cl and &nvt_read) { last if /^\s*$/ }
+        $data = '';
+        while (<STDIN>) {
+          if ($p =~ /password/i) {
+            debuglog('*' x length)
+          } else {
+            debuglog($_)
+          }
+          $RB += length;
+          last if /^--\Q$boundary/;
+          $data .= $_;
+        }
+        unless (defined $_) { die "premature end of HTTP POST\n" }
+        $data =~ s/\r?\n$//;
+        if ($filename) {
+          $PARAM{$p}{filename} = $filename;
+          $PARAM{$p}{data} = $data;
+        } else {
+          $PARAM{$p} = $data;
+        }
+        last if /^--\Q$boundary--/;
+      }
+    }
+  }
+}
+
+
 # name based virtual host?
 sub vhost {
   my $hh = shift; # HTTP_HOST
@@ -1102,13 +1273,14 @@ sub vhost {
 
   # memorized vhost? (default is in fex.ph)
   %vhost = split(':',$ENV{VHOST}) if $ENV{VHOST};
-    
+
   if (%vhost and $hh and $hh =~ s/^([\w\.-]+).*/$1/) {
     if ($vhost = $vhost{$hh} and -f "$vhost/lib/fex.ph") {
       $ENV{VHOST} = "$hh:$vhost"; # memorize vhost for next run
       $ENV{FEXLIB} = $FEXLIB = "$vhost/lib";
       $logdir = $spooldir    = "$vhost/spool";
       $docdir                = "$vhost/htdocs";
+      @logdir = ($logdir);
       if ($locale and -e "$vhost/locale/$locale/lib/fex.ph") {
         $ENV{FEXLIB} = $FEXLIB = "$vhost/locale/$locale/lib";
       }
@@ -1128,41 +1300,55 @@ sub gpg_encrypt {
   my ($plain,$to,$keyring,$from) = @_;
   my ($pid,$pi,$po,$pe,$enc,$err);
   local $_;
-  
+
   $pe = gensym;
-  
+
   $pid = open3($po,$pi,$pe,
     "gpg --batch --trust-model always --keyring $keyring".
     "    -a -e -r $bcc -r $to"
   ) or return;
-  
-  print {$po} $plain;
+
+  print {$po} "\n",$plain,"\n";
   close $po;
-    
+
   $enc .= $_ while <$pi>;
   $err .= $_ while <$pe>;
   errorlog("($from --> $to) $err") if $err;
-  
+
   close $pi;
   close $pe;
   waitpid($pid,0);
-  
+
   return $enc;
 }
 
 
+sub mtime {
+  my @s = stat(shift) or return;
+  return $s[9];
+}
+
+
+# wildcard * to perl regexp
+sub quotewild {
+  local $_ = quotemeta shift;
+  s/\\\*/.*/g; # allow wildcard *
+  return $_;
+}
+
+
 # extract locale functions into hash of subroutine references
 # e.g. \&german ==> $notify{german}
 sub locale_functions {
   my $locale = shift;
   local $/;
   local $_;
-  
+
   if ($locale and open my $fexpp,"$FEXHOME/locale/$locale/lib/fex.pp") {
     $_ = <$fexpp>;
     s/.*\n(\#\#\# locale functions)/$1/s;
     # sub xx {} ==> xx{$locale} = sub {}
-    s/\nsub (\w+)/\n\$$1\{$locale\} = sub/gs; 
+    s/\nsub (\w+)/\n\$$1\{$locale\} = sub/gs;
     s/\n}\n/\n};\n/gs;
     eval $_;
     close $fexpp;
@@ -1179,7 +1365,7 @@ sub notify_locale {
     $file = $dkey;
     $dkey = readlink("$file/dkey");
   } else {
-    $file = readlink("$dkeydir/$dkey") 
+    $file = readlink("$dkeydir/$dkey")
       or http_die("internal error: no DKEY $DKEY");
   }
   $file =~ s:^../::;
@@ -1189,13 +1375,13 @@ sub notify_locale {
   $mtime = mtime("$file/data") or http_die("internal error: no $file/data");
   $comment = slurp("$file/comment") || '';
   $replyto = readlink "$file/replyto" || '';
-  $autodelete = readlink "$file/autodelete" 
-             || readlink "$to/\@AUTODELETE" 
+  $autodelete = readlink "$file/autodelete"
+             || readlink "$to/\@AUTODELETE"
              || $::autodelete;
-  $keep = readlink "$file/keep" 
-       || readlink "$to/\@KEEP" 
+  $keep = readlink "$file/keep"
+       || readlink "$to/\@KEEP"
        || $keep_default;
-  
+
   $locale = readlink "$to/\@LOCALE" || readlink "$file/locale" || 'english';
   $_ = untaint("$FEXHOME/locale/$locale/lib/lf.pl");
   require if -f;
@@ -1207,23 +1393,27 @@ sub notify_locale {
     status     => $status,
     dkey       => $dkey,
     filename   => $filename,
-    keep       => $keep-int((time-$mtime)/DS),
+    keep       => $keep-int((time-$mtime)/$DS),
     comment    => $comment,
     autodelete => $autodelete,
     replyto    => $replyto,
   );
 }
 
-### locale functions ###
-# will be extracted by install process and saved in $FEXHOME/lib/lf.pl
-# you cannot modify them here without re-installing!
+########################### locale functions ###########################
+# Will be extracted by install process and saved in $FEXHOME/lib/lf.pl #
+# You cannot modify them here without re-installing!                   #
+########################################################################
 
+# locale function!
 sub notify {
   # my ($status,$dkey,$filename,$keep,$warn,$comment,$autodelete) = @_;
   my %P = @_;
   my ($to,$from,$file,$mimefilename,$receiver,$warn,$comment,$autodelete);
-  my ($size,$bytes,$days,$header,$data,$replyto);
+  my ($size,$bytes,$days,$header,$data,$replyto,$uurl);
   my ($mfrom,$mto,$dfrom,$dto);
+  my $proto = 'http';
+  my $durl = $::durl;
   my $index;
   my $fileid = 0;
   my $fua = $ENV{HTTP_USER_AGENT}||'';
@@ -1235,15 +1425,22 @@ sub notify {
   my ($body,$enc_body);
 
   return if $nomail;
-  
+
   $warn = $P{warn}||2;
-  $comment = encode_utf8($P{comment}||'');
+  $comment = $P{comment}||'';
+  $comment = encode_utf8($P{comment}||'') if utf8::is_utf8($comment);
   $comment =~ s/^!\*!//; # multi download allow flag
   $autodelete = $P{autodelete}||$::autodelete;
-  $index = $durl;
-  $index =~ s/fop/index.html/;
 
-  (undef,$to,$from,$file) = split('/',untaint(readlink("$dkeydir/$P{dkey}")));
+  $file = untaint(readlink("$dkeydir/$P{dkey}"));
+  $file =~ s/^\.\.\///;
+  # make download protocal same as upload protocol
+  if ($uurl = readlink("$file/uurl") and $uurl =~ /^(\w+):/) {
+    $proto = $1;
+    $durl =~ s/^\w+::/$proto::/;
+  }
+  $index = "$proto://$hostname/index.html";
+  ($to,$from,$file) = split('/',$file);
   $filename = strip_path($P{filename});
   $mfrom = $from;
   $mto = $to;
@@ -1258,10 +1455,17 @@ sub notify {
   $data = "$dkeydir/$P{dkey}/data";
   $size = $bytes = -s $data;
   return unless $size;
-  $warning = 
-    "Please avoid download with Internet Explorer, ".
-    "because it has too many bugs.\n".
-    "We recommend Firefox or wget.";
+  $warning =
+    "We recommend fexget or fexit for download,\n".
+    "because these clients can resume the download after an interruption.\n".
+    "See $proto://$hostname/tools.html";
+  # if ($nowarning) {
+  #   $warning = '';
+  # } else {
+  #   $warning =
+  #     "Please avoid download with Internet Explorer, ".
+  #     "because it has too many bugs.\n\n";
+  # }
   if ($filename =~ /\.(tar|zip|7z|arj|rar)$/) {
     $warning .= "\n\n".
       "$filename is a container file.\n".
@@ -1288,17 +1492,22 @@ sub notify {
   } else {
     $autodelete = '';
   }
-  $mimefilename = $filename;
-  if ($mimefilename =~ s{([_\?\=\x00-\x1F\x7F-\xFF])}{sprintf("=%02X",ord($1))}eog) {
-    $mimefilename =~ s/ /_/g;
-    $mimefilename = '=?UTF-8?Q?'.$mimefilename.'?=';
+
+  if (-s $keyring) {
+    $mimefilename = '';
+  } else {
+    $mimefilename = $filename;
+    if ($mimefilename =~ s/([_\?\=\x00-\x1F\x7F-\xFF])/sprintf("=%02X",ord($1))/eog) {
+      $mimefilename =~ s/ /_/g;
+      $mimefilename = '=?UTF-8?Q?'.$mimefilename.'?=';
+    }
   }
-  
+
   unless ($fileid = readlink("$dkeydir/$P{dkey}/id")) {
     my @s = stat($data);
     $fileid =  @s ? $s[1].$s[9] : 0;
   }
-  
+
   if ($P{status} eq 'new') {
     $days = $P{keep};
     $header .= "Subject: F*EX-upload: $mimefilename\n";
@@ -1308,62 +1517,61 @@ sub notify {
   }
   $header .= "X-FEX-Client-Address: $fra\n" if $fra;
   $header .= "X-FEX-Client-Agent: $fua\n"   if $fua;
-  foreach my $u (@durl) {
+  foreach my $u (@durl?@durl:($durl)) {
     my $durl = sprintf("%s/%s/%s",$u,$P{dkey},normalize_filename($filename));
     $header .= "X-FEX-URL: $durl\n" unless -s $keyring;
     $download .= "$durl\n";
   }
-  $header .= 
+  $header .=
     "X-FEX-Filesize: $bytes\n".
     "X-FEX-File-ID: $fileid\n".
     "X-FEX-Fexmaster: $ENV{SERVER_ADMIN}\n".
     "X-Mailer: F*EX\n".
     "MIME-Version: 1.0\n";
-  if ($comment =~ s/^\[(\@(.*?))\]\s*//) { 
+  if ($comment =~ s/^\[(\@(.*?))\]\s*//) {
     $receiver = "group $1";
     if ($_ = readlink "$from/\@GROUP/$2" and m:^../../(.+?)/:) {
       $receiver .= " (maintainer: $1)";
     }
-  } else { 
+  } else {
     $receiver = 'you';
   }
   if ($days == 1) { $days .= " day" }
   else            { $days .= " days" }
-  
+
   # explicite sender set in fex.ph?
   if ($sender_from) {
     map { s/^From: <$mfrom/From: <$sender_from/ } $header;
     open $sendmail,'|-',$sendmail,$mto,$bcc
-      or http_die("cannot start sendmail - $!\n");
+      or http_die("cannot start sendmail - $!");
   } else {
-    # for special remote domains do not use same domain in From, 
+    # for special remote domains do not use same domain in From,
     # because remote MTA will probably reject this e-mail
     $dfrom = $1 if $mfrom =~ /@(.+)/;
     $dto   = $1 if $mto   =~ /@(.+)/;
-    if ($dfrom and $dto and @remote_domains and 
-        grep { 
-          $dfrom =~ /(^|\.)$_$/ and $dto =~ /(^|\.)$_$/ 
-        } @remote_domains) 
+    if ($dfrom and $dto and @remote_domains and
+        grep {
+          $dfrom =~ /(^|\.)$_$/ and $dto =~ /(^|\.)$_$/
+        } @remote_domains)
     {
       $header =~ s/(From: <)\Q$mfrom\E(.*?)\n/$1$admin$2\nReply-To: $mfrom\n/;
       open $sendmail,'|-',$sendmail,$mto,$bcc
-        or http_die("cannot start sendmail - $!\n");
+        or http_die("cannot start sendmail - $!");
     } else {
       open $sendmail,'|-',$sendmail,'-f',$mfrom,$mto,$bcc
-        or http_die("cannot start sendmail - $!\n");
+        or http_die("cannot start sendmail - $!");
     }
   }
-  if ($comment =~ s/^!(shortmail|\.)!\s*//i 
-    or (readlink "$to/\@NOTIFICATION"||'') =~ /short/i
+  $comment = "\n$comment\n" if $comment;
+  if ($comment =~ s/\n!(shortmail|\.)!\s*//i
+    or (readlink("$to/\@NOTIFICATION")||'') =~ /short/i
   ) {
     $body = qqq(qq(
       '$comment'
-      ''
       '$download'
       '$size'
     ));
   } else {
-    $comment = "Comment: $comment\n" if $comment;
     $disclaimer = slurp("$from/\@DISCLAIMER") || qqq(qq(
       '$warning'
       ''
@@ -1372,8 +1580,9 @@ sub notify {
       ''
       'Questions? ==> F*EX admin: $admin'
     ));
-    $disclaimer .= "\n" . $::disclaimer if $::disclaimer;
+    $disclaimer .= "\n$::disclaimer\n" if $::disclaimer;
     $body = qqq(qq(
+      '$comment'
       '$from has uploaded the file'
       '  "$filename"'
       '($size) for $receiver. Use'
@@ -1381,12 +1590,12 @@ sub notify {
       '$download'
       'to download this file within $days.'
       ''
-      '$comment'
       '$autodelete'
       ''
       '$disclaimer'
     ));
   }
+  $body =~ s/\n\n+/\n\n/g;
   if (-s $keyring) {
     $enc_body = gpg_encrypt($body,$to,$keyring,$from);
   }
@@ -1417,30 +1626,32 @@ sub notify {
       "Content-Transfer-Encoding: 8bit\n";
   }
   print {$sendmail} $header,"\n",$body;
-  close $sendmail
-    or $! and http_die("cannot send notification e-mail (sendmail error $!)\n");
-  return $to;
+  close $sendmail and return $to;
+  http_die("cannot send notification e-mail (sendmail error $!)");
 }
 
 
+# locale function!
 sub reactivation {
   my ($expire,$user) = @_;
   my $fexsend = "$FEXHOME/bin/fexsend";
+  my $reactivation = "$FEXLIB/reactivation.txt";
 
   return if $nomail;
-  
+
   if (-x $fexsend) {
+    if ($locale) {
+      my $lr = "$FEXHOME/locale/$locale/lib/reactivation.txt";
+      $reactivation = $lr if -f $lr and -s $lr;
+    }
     $fexsend .= " -M -D -k 30 -C"
                ." 'Your F*EX account has been inactive for $expire days,"
                ." you must download this file to reactivate it."
                ." Otherwise your account will be deleted.'"
-               ." $FEXLIB/reactivation.txt $user";
+               ." $reactivation $user";
     # on error show STDOUT and STDERR
-    system "$fexsend >/dev/null 2>&1";
-    if ($?) {
-      warn "$fexsend\n";
-      system $fexsend;
-    }
+    my $fo = `$fexsend 2>&1`;
+    warn $fexsend.'\n'.$fo if $?;
   } else {
     warn "$0: cannot execute $fexsend for reactivation()\n";
   }