]> git.treefish.org Git - fex.git/blobdiff - lib/fex.pp
Original release 20160328
[fex.git] / lib / fex.pp
index 352b41298ebc5c47194e26c4368fdae9d94c0c77..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;
@@ -62,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) {
@@ -71,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 - $!";
 
@@ -89,6 +98,13 @@ $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'});
 
@@ -110,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");
@@ -154,18 +170,20 @@ $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 = 80;
+  my $xinetd = '/etc/xinetd.d/fex';
+
   if (@durl) {
     $durl = $durl[0];
   } elsif ($ENV{HTTP_HOST} and $ENV{PROTO}) {
-    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") {
+      if (open $xinetd,$xinetd) {
         while (<$xinetd>) {
           if (/^\s*port\s*=\s*(\d+)/) {
             $port = $1;
@@ -175,7 +193,7 @@ 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";
@@ -183,9 +201,23 @@ unless ($durl) {
       $durl = "$ENV{PROTO}://$host:$port/fop";
     }
   } else {
-    $durl = "http://$hostname/fop";
+    if (open $xinetd,$xinetd) {
+      while (<$xinetd>) {
+        if (/^\s*port\s*=\s*(\d+)/) {
+          $port = $1;
+          last;
+        }
+      }
+      close $xinetd;
+    }
+    if ($port == 80) {
+      $durl = "http://$hostname/fop";
+    } else {
+      $durl = "http://$hostname:$port/fop";
+    }
   }
 }
+@durl = ($durl) unless @durl;
 
 
 sub reexec {
@@ -197,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(
@@ -230,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");
@@ -256,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");
@@ -298,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>',
@@ -320,7 +353,7 @@ sub html_header {
     $head .= "<h1>$title</h1>";
   }
   $head .= "\n";
-  
+
   return $head;
 }
 
@@ -330,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);
@@ -356,15 +389,15 @@ sub html_error {
 
 
 sub http_die {
-  
+
   # not in CGI mode
   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";
@@ -375,7 +408,7 @@ sub http_die {
       close $ukey;
     }
   }
-  
+
   html_error($error||'',@_);
 }
 
@@ -401,7 +434,7 @@ sub check_maint {
 
 sub check_status {
   my $user = shift;
-  
+
   $user = lc $user;
   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 
@@ -432,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
@@ -459,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 $_;
 }
 
@@ -478,7 +511,7 @@ sub rmrf {
   my ($file,$dir);
   local *D;
   local $_;
-  
+
   foreach (@files) {
     next if /(^|\/)\.\.$/;
     /(.*)/; $file = $1;
@@ -524,7 +557,7 @@ sub gethostname {
   if ($hostname !~ /\./ and $admin and $admin =~ /\@([\w.-]+)/) {
     $hostname .= '.'.$1;
   }
-  
+
   return $hostname;
 }
 
@@ -532,10 +565,10 @@ sub gethostname {
 # strip off path names (Windows or UNIX)
 sub strip_path {
   local $_ = shift;
-  
+
   s/.*\\// if /^([A-Z]:)?\\/;
   s:.*/::;
-  
+
   return $_;
 }
 
@@ -543,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($_);
 
@@ -553,7 +586,7 @@ sub normalize {
   s/[\x00-\x1F\x80-\x9F]/_/g;
   s/^\s+//;
   s/\s+$//;
-  
+
   return encode_utf8($_);
 }
 
@@ -561,12 +594,12 @@ sub normalize {
 # substitute all critcal chars
 sub normalize_html {
   local $_ = shift;
-  
+
   return '' unless defined $_;
-  
+
   $_ = normalize($_);
   s/[\"<>]//g;
-  
+
   return $_;
 }
 
@@ -580,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/^\./_/;
   /(.*)/;
@@ -603,7 +636,7 @@ 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");
@@ -628,7 +661,7 @@ sub untaint {
 sub checkchars {
   my $input = shift;
   local $_ = shift;
-  
+
   if (/^([|+.])/) {
     http_die("\"$1\" is not allowed at beginning of $input");
   }
@@ -651,9 +684,9 @@ sub checkaddress {
   my $re;
   local $_;
   local ($domain,$dns);
-  
+
   $a =~ s/:\w+=.*//; # remove options from address
-  
+
   return $a if $a eq 'anonymous';
 
   $a .= '@'.$mdomain if $mdomain and $a !~ /@/;
@@ -666,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;
@@ -674,7 +707,7 @@ sub checkaddress {
         unless ($dns or mx('uni-stuttgart.de')) {
           http_die("Internal error: bad resolver");
         }
-      } 
+      }
     };
     if ($dns) {
       return untaint($a);
@@ -699,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) {
@@ -716,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;
 }
@@ -729,7 +761,7 @@ sub randstring {
 sub mkdirp {
   my $dir = shift;
   my $pdir;
-  
+
   return if -d $dir;
   $dir =~ s:/+$::;
   http_die("cannot mkdir /") unless $dir;
@@ -762,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 =~ /(.+)-(.+)/) {
@@ -805,12 +837,12 @@ sub filename {
     chomp $filename;
     close $file;
   }
-  
+
   unless ($filename) {
     $filename = $file;
     $filename =~ s:.*/::;
   }
-  
+
   return $filename;
 }
 
@@ -842,7 +874,7 @@ sub fdlog {
 sub debuglog {
   my $prg = $0;
   local $_;
-  
+
   return unless $debug and @_;
   unless ($debuglog and fileno $debuglog) {
     my $ddir = "$spooldir/.debug";
@@ -852,12 +884,15 @@ sub debuglog {
     $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} $_;
@@ -887,7 +922,7 @@ sub errorlog {
 sub writelog {
   my $log = shift;
   my $msg = shift;
-  
+
   foreach my $logdir (@logdir) {
     if (open $log,'>>',"$logdir/$log") {
       flock $log,LOCK_EX;
@@ -929,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";
 
@@ -964,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(@_);
 }
 
@@ -976,7 +1013,7 @@ sub check_sender_quota {
   my $du = 0;
   my ($file,$size,%file,$data,$upload);
   local $_;
-  
+
   if (open $qf,'<',"$sender/\@QUOTA") {
     while (<$qf>) {
       s/#.*//;
@@ -984,7 +1021,7 @@ sub check_sender_quota {
     }
     close $qf;
   }
-  
+
   foreach $file (glob "*/$sender/*") {
     $data = "$file/data";
     $upload = "$file/upload";
@@ -1004,7 +1041,7 @@ sub check_sender_quota {
       }
     }
   }
-  
+
   return($squota,int($du/1024/1024));
 }
 
@@ -1016,7 +1053,7 @@ sub check_recipient_quota {
   my $du = 0;
   my ($file,$size);
   local $_;
-  
+
   if (open my $qf,'<',"$recipient/\@QUOTA") {
     while (<$qf>) {
       s/#.*//;
@@ -1024,7 +1061,7 @@ sub check_recipient_quota {
     }
     close $qf;
   }
-  
+
   foreach $file (glob "$recipient/*/*") {
     if (-f "$file/upload" and $size = readlink "$file/size") {
       $du += $size;
@@ -1032,7 +1069,7 @@ sub check_recipient_quota {
       $du += $size;
     }
   }
-  
+
   return($rquota,int($du/1024/1024));
 }
 
@@ -1049,7 +1086,7 @@ sub getline {
 sub wcmatch {
   local $_ = shift;
   my $p = quotemeta shift;
-  
+
   $p =~ s/\\\*/.*/g;
   $p =~ s/\\\?/./g;
   $p =~ s/\\\[/[/g;
@@ -1058,7 +1095,7 @@ sub wcmatch {
   return /$p/;
 }
 
-  
+
 sub logout {
   my $logout;
   if    ($skey) { $logout = "/fup?logout=skey:$skey" }
@@ -1078,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/.//;
@@ -1088,7 +1125,7 @@ sub DD {
   s/</&lt;/g;
   print "<pre>\n$_\n</pre>\n";
 }
-  
+
 # make symlink
 sub mksymlink {
   my ($file,$link) = @_;
@@ -1105,7 +1142,7 @@ sub copy {
   my $link;
   local $/;
   local $_;
-  
+
   $to .= '/'.basename($from) if -d $to;
 
   if (defined($link = readlink $from)) {
@@ -1119,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;
     }
@@ -1133,7 +1170,7 @@ sub slurp {
   my $file = shift;
   local $_;
   local $/;
-  
+
   if (open $file,$file) {
     $_ = <$file>;
     close $file;
@@ -1177,11 +1214,13 @@ sub parse_parameters {
   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{$_} = $_ }
@@ -1234,7 +1273,7 @@ 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
@@ -1261,25 +1300,25 @@ 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;
 }
 
@@ -1290,18 +1329,26 @@ sub mtime {
 }
 
 
+# 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;
@@ -1318,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:^../::;
@@ -1328,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;
@@ -1353,10 +1400,12 @@ sub notify_locale {
   );
 }
 
-### 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 = @_;
@@ -1376,12 +1425,13 @@ 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;
-  
+
   $file = untaint(readlink("$dkeydir/$P{dkey}"));
   $file =~ s/^\.\.\///;
   # make download protocal same as upload protocol
@@ -1405,14 +1455,17 @@ sub notify {
   $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".
@@ -1448,13 +1501,13 @@ sub notify {
       $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";
@@ -1469,37 +1522,37 @@ sub notify {
     $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 - $!");
   } 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
@@ -1509,17 +1562,16 @@ sub notify {
         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'
       ''
@@ -1528,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'
@@ -1537,7 +1590,6 @@ sub notify {
       '$download'
       'to download this file within $days.'
       ''
-      '$comment'
       '$autodelete'
       ''
       '$disclaimer'
@@ -1579,24 +1631,27 @@ sub notify {
 }
 
 
+# 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";
   }