]> git.treefish.org Git - fex.git/blobdiff - lib/fex.pp
projects / fex.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Original release 20160104
[fex.git] / lib / fex.pp
diff --git a/lib/fex.pp b/lib/fex.pp
index bd7ed98b8c1da2fce22eb65ddad6ee44b0da7f0c..be911d2fd9f70b67263bec01bd85b4b92d41dfc0 100644 (file)
--- a/lib/fex.pp
+++ b/lib/fex.pp
@@ -1,6 +1,7 @@
 #  -*- perl -*-
 
 use 5.008;
 #  -*- perl -*-
 
 use 5.008;
+use utf8;
 use Fcntl              qw':flock :seek :mode';
 use IO::Handle;
 use IPC::Open3;
 use Fcntl              qw':flock :seek :mode';
 use IO::Handle;
 use IPC::Open3;
@@ -71,7 +72,7 @@ if ($FHS) {
   $docdir = '/var/lib/fex/htdocs';
   $notify_newrelease = '';
 }
   $docdir = '/var/lib/fex/htdocs';
   $notify_newrelease = '';
 }
-  
+
 # allowed download managers (HTTP User-Agent)
 $adlm = '^(Axel|fex)';
 
 # allowed download managers (HTTP User-Agent)
 $adlm = '^(Axel|fex)';
 
@@ -114,14 +115,14 @@ $ENV{PROTO} = 'http' unless $ENV{PROTO};
 $keep = $keep_default ||= $keep || 5;
 $fra = $ENV{REMOTE_ADDR} || '';
 $sid = $ENV{SID} || '';
 $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");
 
 if (my $ra = $ENV{REMOTE_ADDR} and $max_fail) {
   mkdirp("$spooldir/.fail");
@@ -161,14 +162,14 @@ unless ($durl) {
   my $host = '';
   my $port = 80;
   my $xinetd = '/etc/xinetd.d/fex';
   my $host = '';
   my $port = 80;
   my $xinetd = '/etc/xinetd.d/fex';
-  
+
   if (@durl) {
     $durl = $durl[0];
   } elsif ($ENV{HTTP_HOST} and $ENV{PROTO}) {
   if (@durl) {
     $durl = $durl[0];
   } elsif ($ENV{HTTP_HOST} and $ENV{PROTO}) {
-  
+
     ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
     $host = $hostname;
     ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
     $host = $hostname;
-  
+
     unless ($port) {
       $port = 80;
       if (open $xinetd,$xinetd) {
     unless ($port) {
       $port = 80;
       if (open $xinetd,$xinetd) {
@@ -181,7 +182,7 @@ unless ($durl) {
         close $xinetd;
       }
     }
         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";
     # use same protocal as uploader for download
     if ($ENV{PROTO} eq 'https' and $port == 443 or $port == 80) {
       $durl = "$ENV{PROTO}://$host/fop";
@@ -217,7 +218,7 @@ sub reexec {
 sub jsredirect {
   $url = shift;
   $cont = shift || 'request accepted: continue';
 sub jsredirect {
   $url = shift;
   $cont = shift || 'request accepted: continue';
-  
+
   http_header('200 ok');
   print html_header($head||$ENV{SERVER_NAME});
   pq(qq(
   http_header('200 ok');
   print html_header($head||$ENV{SERVER_NAME});
   pq(qq(
@@ -250,24 +251,24 @@ sub nvt_print {
 
 sub html_quote {
   local $_ = shift;
 
 sub html_quote {
   local $_ = shift;
-  
+
   s/&/&/g;
   s/</&lt;/g;
   s/\"/&quot;/g;
   s/&/&amp;/g;
   s/</&lt;/g;
   s/\"/&quot;/g;
-  
+
   return $_;
 }
 
 
 
 sub http_header {
   return $_;
 }
 
 
 
 sub http_header {
-  
+
   my $status = shift;
   my $msg = $status;
 
   return if $HTTP_HEADER;
   $HTTP_HEADER = $status;
   my $status = shift;
   my $msg = $status;
 
   return if $HTTP_HEADER;
   $HTTP_HEADER = $status;
-  
+
   $msg =~ s/^\d+\s*//;
 
   nvt_print("HTTP/1.1 $status");
   $msg =~ s/^\d+\s*//;
 
   nvt_print("HTTP/1.1 $status");
@@ -280,11 +281,12 @@ sub http_header {
   nvt_print("X-Frame-Options: SAMEORIGIN");
   if ($force_https) {
     # https://www.owasp.org/index.php/HTTP_Strict_Transport_Security
   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");
+    nvt_print("Strict-Transport-Security: max-age=2851200; preload");
   }
   if ($use_cookies) {
   }
   if ($use_cookies) {
+    $akey = md5_hex("$from:$id") if $id and $from;
     if ($akey) {
     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");
     }
     # if ($skey) {
     #   nvt_print("Set-Cookie: skey=$skey; Max-Age=9999; Discard");
@@ -318,19 +320,19 @@ sub html_header {
     '</head>'
   ));
   # '<!-- <style type="text/css">\@import "/fex.css";</style> -->'
     '</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" }
   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;
   }
   $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);
   $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>',
   if (@H1_extra) {
     $head .= sprintf(
       '<h1><a href="%s"><img align=center src="%s" border=0></a>%s</h1>',
@@ -340,7 +342,7 @@ sub html_header {
     $head .= "<h1>$title</h1>";
   }
   $head .= "\n";
     $head .= "<h1>$title</h1>";
   }
   $head .= "\n";
-  
+
   return $head;
 }
 
   return $head;
 }
 
@@ -350,14 +352,14 @@ sub html_error {
   my $msg = "@_";
   my @msg = @_;
   my $isodate = isodate(time);
   my $msg = "@_";
   my @msg = @_;
   my $isodate = isodate(time);
-  
+
   $msg =~ s/[\s\n]+/ /g;
   $msg =~ s/<.+?>//g; # remove HTML
   map { s/<script.*?>//gi } @msg;
   $msg =~ s/[\s\n]+/ /g;
   $msg =~ s/<.+?>//g; # remove HTML
   map { s/<script.*?>//gi } @msg;
-  
+
   errorlog($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);
   # Internet Explorer then refuses to display HTML body!
   http_header("666 Bad Request - $msg");
   print html_header($error);
@@ -376,15 +378,15 @@ sub html_error {
 
 
 sub http_die {
 
 
 sub http_die {
-  
+
   # not in CGI mode
   unless ($ENV{GATEWAY_INTERFACE}) {
     warn "$0: @_\n"; # must not die, because of fex_cleanup!
     return;
   }
   # not in CGI mode
   unless ($ENV{GATEWAY_INTERFACE}) {
     warn "$0: @_\n"; # must not die, because of fex_cleanup!
     return;
   }
-  
+
   debuglog(@_);
   debuglog(@_);
-  
+
   # create special error file on upload
   if ($uid) {
     my $ukey = "$spooldir/.ukeys/$uid";
   # create special error file on upload
   if ($uid) {
     my $ukey = "$spooldir/.ukeys/$uid";
@@ -395,7 +397,7 @@ sub http_die {
       close $ukey;
     }
   }
       close $ukey;
     }
   }
-  
+
   html_error($error||'',@_);
 }
 
   html_error($error||'',@_);
 }
 
@@ -421,7 +423,7 @@ sub check_maint {
 
 sub check_status {
   my $user = shift;
 
 sub check_status {
   my $user = shift;
-  
+
   $user = lc $user;
   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 
   $user = lc $user;
   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 
@@ -452,7 +454,7 @@ sub encode_Q {
   my $s = shift;
   $s =~ s{([\=\x00-\x20\x7F-\xA0])}{sprintf("=%02X",ord($1))}eog;
   return $s;
   my $s = shift;
   $s =~ s{([\=\x00-\x20\x7F-\xA0])}{sprintf("=%02X",ord($1))}eog;
   return $s;
-}  
+}
 
 
 # from MIME::Base64::Perl
 
 
 # from MIME::Base64::Perl
@@ -479,13 +481,13 @@ sub decode_b64 {
 sub b64 {
   local $_ = '';
   my $x = 0;
 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}$//;
   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 $_;
 }
 
   return $_;
 }
 
@@ -498,7 +500,7 @@ sub rmrf {
   my ($file,$dir);
   local *D;
   local $_;
   my ($file,$dir);
   local *D;
   local $_;
-  
+
   foreach (@files) {
     next if /(^|\/)\.\.$/;
     /(.*)/; $file = $1;
   foreach (@files) {
     next if /(^|\/)\.\.$/;
     /(.*)/; $file = $1;
@@ -544,7 +546,7 @@ sub gethostname {
   if ($hostname !~ /\./ and $admin and $admin =~ /\@([\w.-]+)/) {
     $hostname .= '.'.$1;
   }
   if ($hostname !~ /\./ and $admin and $admin =~ /\@([\w.-]+)/) {
     $hostname .= '.'.$1;
   }
-  
+
   return $hostname;
 }
 
   return $hostname;
 }
 
@@ -552,10 +554,10 @@ sub gethostname {
 # strip off path names (Windows or UNIX)
 sub strip_path {
   local $_ = shift;
 # strip off path names (Windows or UNIX)
 sub strip_path {
   local $_ = shift;
-  
+
   s/.*\\// if /^([A-Z]:)?\\/;
   s:.*/::;
   s/.*\\// if /^([A-Z]:)?\\/;
   s:.*/::;
-  
+
   return $_;
 }
 
   return $_;
 }
 
@@ -563,9 +565,9 @@ sub strip_path {
 # substitute all critcal chars
 sub normalize {
   local $_ = shift;
 # substitute all critcal chars
 sub normalize {
   local $_ = shift;
-  
+
   return '' unless defined $_;
   return '' unless defined $_;
-  
+
   # we need perl native utf8 (see perldoc utf8)
   $_ = decode_utf8($_) unless utf8::is_utf8($_);
 
   # we need perl native utf8 (see perldoc utf8)
   $_ = decode_utf8($_) unless utf8::is_utf8($_);
 
@@ -573,7 +575,7 @@ sub normalize {
   s/[\x00-\x1F\x80-\x9F]/_/g;
   s/^\s+//;
   s/\s+$//;
   s/[\x00-\x1F\x80-\x9F]/_/g;
   s/^\s+//;
   s/\s+$//;
-  
+
   return encode_utf8($_);
 }
 
   return encode_utf8($_);
 }
 
@@ -581,12 +583,12 @@ sub normalize {
 # substitute all critcal chars
 sub normalize_html {
   local $_ = shift;
 # substitute all critcal chars
 sub normalize_html {
   local $_ = shift;
-  
+
   return '' unless defined $_;
   return '' unless defined $_;
-  
+
   $_ = normalize($_);
   s/[\"<>]//g;
   $_ = normalize($_);
   s/[\"<>]//g;
-  
+
   return $_;
 }
 
   return $_;
 }
 
@@ -600,20 +602,20 @@ sub normalize_filename {
 
   # we need native utf8
   $_ = decode_utf8($_) unless utf8::is_utf8($_);
 
   # we need native utf8
   $_ = decode_utf8($_) unless utf8::is_utf8($_);
- 
+
   $_ = strip_path($_);
   $_ = strip_path($_);
-  
+
   # substitute all critcal chars with underscore
   s/[^a-zA-Z0-9_=.+-]/_/g;
   s/^\./_/;
   # substitute all critcal chars with underscore
   s/[^a-zA-Z0-9_=.+-]/_/g;
   s/^\./_/;
-  
+
   return encode_utf8($_);
 }
 
 
 sub normalize_email {
   local $_ = lc shift;
   return encode_utf8($_);
 }
 
 
 sub normalize_email {
   local $_ = lc shift;
-  
+
   s/[^\w_.+=!~#^\@\-]//g;
   s/^\./_/;
   /(.*)/;
   s/[^\w_.+=!~#^\@\-]//g;
   s/^\./_/;
   /(.*)/;
@@ -623,7 +625,7 @@ sub normalize_email {
 
 sub normalize_user {
   my $user = shift;
 
 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");
   $user = lc(urldecode(despace($user)));
   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
   checkaddress($user) or http_die("$user is not a valid e-mail address");
@@ -648,7 +650,7 @@ sub untaint {
 sub checkchars {
   my $input = shift;
   local $_ = shift;
 sub checkchars {
   my $input = shift;
   local $_ = shift;
-  
+
   if (/^([|+.])/) {
     http_die("\"$1\" is not allowed at beginning of $input");
   }
   if (/^([|+.])/) {
     http_die("\"$1\" is not allowed at beginning of $input");
   }
@@ -671,9 +673,9 @@ sub checkaddress {
   my $re;
   local $_;
   local ($domain,$dns);
   my $re;
   local $_;
   local ($domain,$dns);
-  
+
   $a =~ s/:\w+=.*//; # remove options from address
   $a =~ s/:\w+=.*//; # remove options from address
-  
+
   return $a if $a eq 'anonymous';
 
   $a .= '@'.$mdomain if $mdomain and $a !~ /@/;
   return $a if $a eq 'anonymous';
 
   $a .= '@'.$mdomain if $mdomain and $a !~ /@/;
@@ -686,7 +688,7 @@ sub checkaddress {
   $re = '^[!^=~#_:.+*{}\w\-\[\]]+\@(\w[.\w\-]*\.[a-z]+)$';
   if ($a =~ /$re/i) {
     $domain = $dns = $1;
   $re = '^[!^=~#_:.+*{}\w\-\[\]]+\@(\w[.\w\-]*\.[a-z]+)$';
   if ($a =~ /$re/i) {
     $domain = $dns = $1;
-    { 
+    {
       local $SIG{__DIE__} = sub { die "\n" };
       eval q{
         use Net::DNS;
       local $SIG{__DIE__} = sub { die "\n" };
       eval q{
         use Net::DNS;
@@ -694,7 +696,7 @@ sub checkaddress {
         unless ($dns or mx('uni-stuttgart.de')) {
           http_die("Internal error: bad resolver");
         }
         unless ($dns or mx('uni-stuttgart.de')) {
           http_die("Internal error: bad resolver");
         }
-      } 
+      }
     };
     if ($dns) {
       return untaint($a);
     };
     if ($dns) {
       return untaint($a);
@@ -735,10 +737,10 @@ sub checkforbidden {
 
 sub randstring {
   my $n = shift;
 
 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;
   my $rs;
-  
+
   for (1..$n) { $rs .= $rc[int(rand($rn))] };
   return $rs;
 }
   for (1..$n) { $rs .= $rc[int(rand($rn))] };
   return $rs;
 }
@@ -748,7 +750,7 @@ sub randstring {
 sub mkdirp {
   my $dir = shift;
   my $pdir;
 sub mkdirp {
   my $dir = shift;
   my $pdir;
-  
+
   return if -d $dir;
   $dir =~ s:/+$::;
   http_die("cannot mkdir /") unless $dir;
   return if -d $dir;
   $dir =~ s:/+$::;
   http_die("cannot mkdir /") unless $dir;
@@ -781,7 +783,7 @@ sub ipin {
 
   $ipe = lc(ipe($ip));
   map { lc } @list;
 
   $ipe = lc(ipe($ip));
   map { lc } @list;
-  
+
   foreach $i (@list) {
     if ($ip =~ /\./ and $i =~ /\./ or $ip =~ /:/ and $i =~ /:/) {
       if ($i =~ /(.+)-(.+)/) {
   foreach $i (@list) {
     if ($ip =~ /\./ and $i =~ /\./ or $ip =~ /:/ and $i =~ /:/) {
       if ($i =~ /(.+)-(.+)/) {
@@ -824,12 +826,12 @@ sub filename {
     chomp $filename;
     close $file;
   }
     chomp $filename;
     close $file;
   }
-  
+
   unless ($filename) {
     $filename = $file;
     $filename =~ s:.*/::;
   }
   unless ($filename) {
     $filename = $file;
     $filename =~ s:.*/::;
   }
-  
+
   return $filename;
 }
 
   return $filename;
 }
 
@@ -861,7 +863,7 @@ sub fdlog {
 sub debuglog {
   my $prg = $0;
   local $_;
 sub debuglog {
   my $prg = $0;
   local $_;
-  
+
   return unless $debug and @_;
   unless ($debuglog and fileno $debuglog) {
     my $ddir = "$spooldir/.debug";
   return unless $debug and @_;
   unless ($debuglog and fileno $debuglog) {
     my $ddir = "$spooldir/.debug";
@@ -871,12 +873,15 @@ sub debuglog {
     $debuglog = sprintf("%s/%s_%s_%s.%s",
                         $ddir,time,$$,$ENV{REQUESTCOUNT}||0,$prg);
     $debuglog =~ s/\s/_/g;
     $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;
     # 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 @_) {
     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} $_;
     s/\n*$/\n/;
     s/<.+?>//g; # remove HTML
     print {$debuglog} $_;
@@ -906,7 +911,7 @@ sub errorlog {
 sub writelog {
   my $log = shift;
   my $msg = shift;
 sub writelog {
   my $log = shift;
   my $msg = shift;
-  
+
   foreach my $logdir (@logdir) {
     if (open $log,'>>',"$logdir/$log") {
       flock $log,LOCK_EX;
   foreach my $logdir (@logdir) {
     if (open $log,'>>',"$logdir/$log") {
       flock $log,LOCK_EX;
@@ -948,11 +953,11 @@ sub qqq {
   my $q = "[\'\"]"; # quote delimiter chars " and '
 
   # remove first newline and look for default indention
   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
   $i = ' ' x ($2||0);
 
   # remove trailing spaces at end
-  s/[ \t]*\»?$//;
+  s/[ \t]*?$//;
 
   @s = split "\n";
 
 
   @s = split "\n";
 
@@ -983,7 +988,9 @@ sub qqq {
 # print superquoted
 sub pq {
   my $H = STDOUT;
 # print superquoted
 sub pq {
   my $H = STDOUT;
+
   if (@_ > 1 and defined fileno $_[0]) { $H = shift }
   if (@_ > 1 and defined fileno $_[0]) { $H = shift }
+  binmode($H,':utf8');
   print {$H} qqq(@_);
 }
 
   print {$H} qqq(@_);
 }
 
@@ -995,7 +1002,7 @@ sub check_sender_quota {
   my $du = 0;
   my ($file,$size,%file,$data,$upload);
   local $_;
   my $du = 0;
   my ($file,$size,%file,$data,$upload);
   local $_;
-  
+
   if (open $qf,'<',"$sender/\@QUOTA") {
     while (<$qf>) {
       s/#.*//;
   if (open $qf,'<',"$sender/\@QUOTA") {
     while (<$qf>) {
       s/#.*//;
@@ -1003,7 +1010,7 @@ sub check_sender_quota {
     }
     close $qf;
   }
     }
     close $qf;
   }
-  
+
   foreach $file (glob "*/$sender/*") {
     $data = "$file/data";
     $upload = "$file/upload";
   foreach $file (glob "*/$sender/*") {
     $data = "$file/data";
     $upload = "$file/upload";
@@ -1023,7 +1030,7 @@ sub check_sender_quota {
       }
     }
   }
       }
     }
   }
-  
+
   return($squota,int($du/1024/1024));
 }
 
   return($squota,int($du/1024/1024));
 }
 
@@ -1035,7 +1042,7 @@ sub check_recipient_quota {
   my $du = 0;
   my ($file,$size);
   local $_;
   my $du = 0;
   my ($file,$size);
   local $_;
-  
+
   if (open my $qf,'<',"$recipient/\@QUOTA") {
     while (<$qf>) {
       s/#.*//;
   if (open my $qf,'<',"$recipient/\@QUOTA") {
     while (<$qf>) {
       s/#.*//;
@@ -1043,7 +1050,7 @@ sub check_recipient_quota {
     }
     close $qf;
   }
     }
     close $qf;
   }
-  
+
   foreach $file (glob "$recipient/*/*") {
     if (-f "$file/upload" and $size = readlink "$file/size") {
       $du += $size;
   foreach $file (glob "$recipient/*/*") {
     if (-f "$file/upload" and $size = readlink "$file/size") {
       $du += $size;
@@ -1051,7 +1058,7 @@ sub check_recipient_quota {
       $du += $size;
     }
   }
       $du += $size;
     }
   }
-  
+
   return($rquota,int($du/1024/1024));
 }
 
   return($rquota,int($du/1024/1024));
 }
 
@@ -1068,7 +1075,7 @@ sub getline {
 sub wcmatch {
   local $_ = shift;
   my $p = quotemeta shift;
 sub wcmatch {
   local $_ = shift;
   my $p = quotemeta shift;
-  
+
   $p =~ s/\\\*/.*/g;
   $p =~ s/\\\?/./g;
   $p =~ s/\\\[/[/g;
   $p =~ s/\\\*/.*/g;
   $p =~ s/\\\?/./g;
   $p =~ s/\\\[/[/g;
@@ -1077,7 +1084,7 @@ sub wcmatch {
   return /$p/;
 }
 
   return /$p/;
 }
 
-  
+
 sub logout {
   my $logout;
   if    ($skey) { $logout = "/fup?logout=skey:$skey" }
 sub logout {
   my $logout;
   if    ($skey) { $logout = "/fup?logout=skey:$skey" }
@@ -1097,7 +1104,7 @@ sub logout {
 # print data dump of global or local variables in HTML
 # input musst be a string, eg: '%ENV'
 sub DD {
 # 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/.//;
   local $_;
 
   $n =~ s/.//;
@@ -1107,7 +1114,7 @@ sub DD {
   s/</&lt;/g;
   print "<pre>\n$_\n</pre>\n";
 }
   s/</&lt;/g;
   print "<pre>\n$_\n</pre>\n";
 }
-  
+
 # make symlink
 sub mksymlink {
   my ($file,$link) = @_;
 # make symlink
 sub mksymlink {
   my ($file,$link) = @_;
@@ -1124,7 +1131,7 @@ sub copy {
   my $link;
   local $/;
   local $_;
   my $link;
   local $/;
   local $_;
-  
+
   $to .= '/'.basename($from) if -d $to;
 
   if (defined($link = readlink $from)) {
   $to .= '/'.basename($from) if -d $to;
 
   if (defined($link = readlink $from)) {
@@ -1138,7 +1145,7 @@ sub copy {
     eval $mod if $mod;
     print {$to} $_;
     close $to or http_die("internal error: $to - $!");
     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;
     }
       chmod $s[2],$to;
       utime @s[8,9],$to unless $mod;
     }
@@ -1152,7 +1159,7 @@ sub slurp {
   my $file = shift;
   local $_;
   local $/;
   my $file = shift;
   local $_;
   local $/;
-  
+
   if (open $file,$file) {
     $_ = <$file>;
     close $file;
   if (open $file,$file) {
     $_ = <$file>;
     close $file;
@@ -1196,11 +1203,13 @@ sub parse_parameters {
   my $data = '';
   my $filename;
   local $_;
   my $data = '';
   my $filename;
   local $_;
-  
+
   if ($cl > 128*$MB) {
     http_die("request too large");
   }
   if ($cl > 128*$MB) {
     http_die("request too large");
   }
-  
+
+  binmode(STDIN,':raw');
+
   foreach (split('&',$ENV{QUERY_STRING})) {
     if (/(.+?)=(.*)/) { $PARAM{$1} = $2 }
     else              { $PARAM{$_} = $_ }
   foreach (split('&',$ENV{QUERY_STRING})) {
     if (/(.+?)=(.*)/) { $PARAM{$1} = $2 }
     else              { $PARAM{$_} = $_ }
@@ -1253,7 +1262,7 @@ sub vhost {
 
   # memorized vhost? (default is in fex.ph)
   %vhost = split(':',$ENV{VHOST}) if $ENV{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
   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
@@ -1280,25 +1289,25 @@ sub gpg_encrypt {
   my ($plain,$to,$keyring,$from) = @_;
   my ($pid,$pi,$po,$pe,$enc,$err);
   local $_;
   my ($plain,$to,$keyring,$from) = @_;
   my ($pid,$pi,$po,$pe,$enc,$err);
   local $_;
-  
+
   $pe = gensym;
   $pe = gensym;
-  
+
   $pid = open3($po,$pi,$pe,
     "gpg --batch --trust-model always --keyring $keyring".
     "    -a -e -r $bcc -r $to"
   ) or return;
   $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;
   close $po;
-    
+
   $enc .= $_ while <$pi>;
   $err .= $_ while <$pe>;
   errorlog("($from --> $to) $err") if $err;
   $enc .= $_ while <$pi>;
   $err .= $_ while <$pe>;
   errorlog("($from --> $to) $err") if $err;
-  
+
   close $pi;
   close $pe;
   waitpid($pid,0);
   close $pi;
   close $pe;
   waitpid($pid,0);
-  
+
   return $enc;
 }
 
   return $enc;
 }
 
@@ -1323,12 +1332,12 @@ sub locale_functions {
   my $locale = shift;
   local $/;
   local $_;
   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 {}
   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;
     s/\n}\n/\n};\n/gs;
     eval $_;
     close $fexpp;
@@ -1345,7 +1354,7 @@ sub notify_locale {
     $file = $dkey;
     $dkey = readlink("$file/dkey");
   } else {
     $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:^../::;
       or http_die("internal error: no DKEY $DKEY");
   }
   $file =~ s:^../::;
@@ -1355,13 +1364,13 @@ sub notify_locale {
   $mtime = mtime("$file/data") or http_die("internal error: no $file/data");
   $comment = slurp("$file/comment") || '';
   $replyto = readlink "$file/replyto" || '';
   $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;
              || $::autodelete;
-  $keep = readlink "$file/keep" 
-       || readlink "$to/\@KEEP" 
+  $keep = readlink "$file/keep"
+       || readlink "$to/\@KEEP"
        || $keep_default;
        || $keep_default;
-  
+
   $locale = readlink "$to/\@LOCALE" || readlink "$file/locale" || 'english';
   $_ = untaint("$FEXHOME/locale/$locale/lib/lf.pl");
   require if -f;
   $locale = readlink "$to/\@LOCALE" || readlink "$file/locale" || 'english';
   $_ = untaint("$FEXHOME/locale/$locale/lib/lf.pl");
   require if -f;
@@ -1405,12 +1414,13 @@ sub notify {
   my ($body,$enc_body);
 
   return if $nomail;
   my ($body,$enc_body);
 
   return if $nomail;
-  
+
   $warn = $P{warn}||2;
   $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;
   $comment =~ s/^!\*!//; # multi download allow flag
   $autodelete = $P{autodelete}||$::autodelete;
-  
+
   $file = untaint(readlink("$dkeydir/$P{dkey}"));
   $file =~ s/^\.\.\///;
   # make download protocal same as upload protocol
   $file = untaint(readlink("$dkeydir/$P{dkey}"));
   $file =~ s/^\.\.\///;
   # make download protocal same as upload protocol
@@ -1434,14 +1444,17 @@ sub notify {
   $data = "$dkeydir/$P{dkey}/data";
   $size = $bytes = -s $data;
   return unless $size;
   $data = "$dkeydir/$P{dkey}/data";
   $size = $bytes = -s $data;
   return unless $size;
-  if ($nowarning) {
-    $warning = '';
-  } else {
-    $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".
   if ($filename =~ /\.(tar|zip|7z|arj|rar)$/) {
     $warning .= "\n\n".
       "$filename is a container file.\n".
@@ -1477,13 +1490,13 @@ sub notify {
       $mimefilename =~ s/ /_/g;
       $mimefilename = '=?UTF-8?Q?'.$mimefilename.'?=';
     }
       $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;
   }
   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";
   if ($P{status} eq 'new') {
     $days = $P{keep};
     $header .= "Subject: F*EX-upload: $mimefilename\n";
@@ -1498,37 +1511,37 @@ sub notify {
     $header .= "X-FEX-URL: $durl\n" unless -s $keyring;
     $download .= "$durl\n";
   }
     $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";
     "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)";
     }
     $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" }
     $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 - $!");
   } else {
   # 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 - $!");
   } 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   =~ /@(.+)/;
     # 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
     {
       $header =~ s/(From: <)\Q$mfrom\E(.*?)\n/$1$admin$2\nReply-To: $mfrom\n/;
       open $sendmail,'|-',$sendmail,$mto,$bcc
@@ -1538,17 +1551,16 @@ sub notify {
         or http_die("cannot start sendmail - $!");
     }
   }
         or http_die("cannot start sendmail - $!");
     }
   }
-  if ($comment =~ s/^!(shortmail|\.)!\s*//i 
-    or (readlink "$to/\@NOTIFICATION"||'') =~ /short/i
+  $comment .= "\n" if $comment;
+  if ($comment =~ s/^!(shortmail|\.)!\s*//i
+    or (readlink("$to/\@NOTIFICATION")||'') =~ /short/i
   ) {
     $body = qqq(qq(
       '$comment'
   ) {
     $body = qqq(qq(
       '$comment'
-      ''
       '$download'
       '$size'
     ));
   } else {
       '$download'
       '$size'
     ));
   } else {
-    $comment = "Comment: $comment\n" if $comment;
     $disclaimer = slurp("$from/\@DISCLAIMER") || qqq(qq(
       '$warning'
       ''
     $disclaimer = slurp("$from/\@DISCLAIMER") || qqq(qq(
       '$warning'
       ''
@@ -1559,6 +1571,7 @@ sub notify {
     ));
     $disclaimer .= "\n" . $::disclaimer if $::disclaimer;
     $body = qqq(qq(
     ));
     $disclaimer .= "\n" . $::disclaimer if $::disclaimer;
     $body = qqq(qq(
+      '$comment'
       '$from has uploaded the file'
       '  "$filename"'
       '($size) for $receiver. Use'
       '$from has uploaded the file'
       '  "$filename"'
       '($size) for $receiver. Use'
@@ -1566,7 +1579,6 @@ sub notify {
       '$download'
       'to download this file within $days.'
       ''
       '$download'
       'to download this file within $days.'
       ''
-      '$comment'
       '$autodelete'
       ''
       '$disclaimer'
       '$autodelete'
       ''
       '$disclaimer'
@@ -1612,21 +1624,23 @@ sub notify {
 sub reactivation {
   my ($expire,$user) = @_;
   my $fexsend = "$FEXHOME/bin/fexsend";
 sub reactivation {
   my ($expire,$user) = @_;
   my $fexsend = "$FEXHOME/bin/fexsend";
+  my $reactivation = "$FEXLIB/reactivation.txt";
 
   return if $nomail;
 
   return if $nomail;
-  
+
   if (-x $fexsend) {
   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.'"
     $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
     # 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";
   }
   } else {
     warn "$0: cannot execute $fexsend for reactivation()\n";
   }
Unofficial F*EX git repository tracking official releases.