X-Git-Url: http://git.treefish.org/fex.git/blobdiff_plain/97b87610331f53e756d032ad21db786037f921a1..e5c93609849bda051fff54b5d5265af5608c6c69:/lib/fex.pp?ds=sidebyside diff --git a/lib/fex.pp b/lib/fex.pp index bd7ed98..c6f0562 100644 --- a/lib/fex.pp +++ b/lib/fex.pp @@ -71,7 +71,7 @@ if ($FHS) { $docdir = '/var/lib/fex/htdocs'; $notify_newrelease = ''; } - + # allowed download managers (HTTP User-Agent) $adlm = '^(Axel|fex)'; @@ -114,7 +114,7 @@ $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 @@ -161,14 +161,14 @@ 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}) { - + ($host,$port) = split(':',$ENV{HTTP_HOST}||''); $host = $hostname; - + unless ($port) { $port = 80; if (open $xinetd,$xinetd) { @@ -181,7 +181,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"; @@ -217,7 +217,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( @@ -250,24 +250,24 @@ sub nvt_print { sub html_quote { local $_ = shift; - + s/&/&/g; s/</g; s/\"/"/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"); @@ -280,7 +280,7 @@ sub http_header { 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 ($akey) { @@ -318,19 +318,19 @@ sub html_header { '' )); # '' - - if ($0 =~ /fexdev/) { $head .= "
\n" } + + if ($0 =~ /fexdev/) { $head .= "\n" } else { $head .= "\n" } - + $title =~ s:F\*EX:F*EX:; if (open $header,'<',"$docdir/$header") { $head .= $_ while <$header>; close $header; } - + $head .= &$prolog($title) if defined($prolog); - + if (@H1_extra) { $head .= sprintf( '\n$_\n\n"; } - + # make symlink sub mksymlink { my ($file,$link) = @_; @@ -1124,7 +1126,7 @@ sub copy { my $link; local $/; local $_; - + $to .= '/'.basename($from) if -d $to; if (defined($link = readlink $from)) { @@ -1138,7 +1140,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; } @@ -1152,7 +1154,7 @@ sub slurp { my $file = shift; local $_; local $/; - + if (open $file,$file) { $_ = <$file>; close $file; @@ -1196,11 +1198,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{$_} = $_ } @@ -1253,7 +1257,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 @@ -1280,25 +1284,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; close $po; - + $enc .= $_ while <$pi>; $err .= $_ while <$pe>; errorlog("($from --> $to) $err") if $err; - + close $pi; close $pe; waitpid($pid,0); - + return $enc; } @@ -1323,12 +1327,12 @@ 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; @@ -1345,7 +1349,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:^../::; @@ -1355,13 +1359,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; @@ -1405,12 +1409,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 @@ -1437,7 +1442,7 @@ sub notify { if ($nowarning) { $warning = ''; } else { - $warning = + $warning = "Please avoid download with Internet Explorer, ". "because it has too many bugs.\n". "We recommend Firefox or wget."; @@ -1477,13 +1482,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"; @@ -1498,37 +1503,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 @@ -1538,7 +1543,7 @@ sub notify { or http_die("cannot start sendmail - $!"); } } - if ($comment =~ s/^!(shortmail|\.)!\s*//i + if ($comment =~ s/^!(shortmail|\.)!\s*//i or (readlink "$to/\@NOTIFICATION"||'') =~ /short/i ) { $body = qqq(qq( @@ -1614,7 +1619,7 @@ sub reactivation { my $fexsend = "$FEXHOME/bin/fexsend"; return if $nomail; - + if (-x $fexsend) { $fexsend .= " -M -D -k 30 -C" ." 'Your F*EX account has been inactive for $expire days,"