Original release 20160104

[fex.git] / lib / fex.pp

diff --git a/lib/fex.pp b/lib/fex.pp
index c6f0562d4328e1a892cf299938321739eeca256d..be911d2fd9f70b67263bec01bd85b4b92d41dfc0 100644 (file)
--- a/lib/fex.pp
+++ b/lib/fex.pp
@@ -1,6 +1,7 @@
 #  -*- perl -*-
 
 use 5.008;
+use utf8;
 use Fcntl              qw':flock :seek :mode';
 use IO::Handle;
 use IPC::Open3;
@@ -115,13 +116,13 @@ $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");
@@ -283,8 +284,9 @@ sub http_header {
     nvt_print("Strict-Transport-Security: max-age=2851200; preload");
   }
   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");
@@ -871,12 +873,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} $_;
@@ -948,11 +953,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";
 
@@ -1292,7 +1297,7 @@ sub gpg_encrypt {
     "    -a -e -r $bcc -r $to"
   ) or return;
 
-  print {$po} $plain;
+  print {$po} "\n",$plain,"\n";
   close $po;
 
   $enc .= $_ while <$pi>;
@@ -1439,14 +1444,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".
@@ -1543,17 +1551,16 @@ sub notify {
         or http_die("cannot start sendmail - $!");
     }
   }
+  $comment .= "\n" if $comment;
   if ($comment =~ s/^!(shortmail|\.)!\s*//i
-    or (readlink "$to/\@NOTIFICATION"||'') =~ /short/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'
       ''
@@ -1564,6 +1571,7 @@ sub notify {
     ));
     $disclaimer .= "\n" . $::disclaimer if $::disclaimer;
     $body = qqq(qq(
+      '$comment'
       '$from has uploaded the file'
       '  "$filename"'
       '($size) for $receiver. Use'
@@ -1571,7 +1579,6 @@ sub notify {
       '$download'
       'to download this file within $days.'
       ''
-      '$comment'
       '$autodelete'
       ''
       '$disclaimer'
@@ -1617,21 +1624,23 @@ sub notify {
 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";
   }