X-Git-Url: http://git.treefish.org/fex.git/blobdiff_plain/e5c93609849bda051fff54b5d5265af5608c6c69..c65ee6f7429eff9a7f58aad7c0aec858ad473092:/lib/fex.pp diff --git a/lib/fex.pp b/lib/fex.pp index c6f0562..be911d2 100644 --- 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"; }