# -*- perl -*-
use 5.008;
+use utf8;
use Fcntl qw':flock :seek :mode';
use IO::Handle;
use IPC::Open3;
$mail_authid = 'yes';
$force_https = 0;
$debug = 0;
+@forbidden_user_agents = ('FDM');
+
+# 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
$ENV{PROTO} = 'http' unless $ENV{PROTO};
$keep = $keep_default ||= $keep || 5;
+$purge ||= 3*$keep;
$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");
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
+ # 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");
my $header = 'header.html';
my $head;
+ binmode(STDOUT,':utf8'); # for text/html !
+
# http://www.w3.org/TR/html401/struct/global.html
# http://www.w3.org/International/O-charset
$head = qqq(qq(
errorlog($msg);
+ $SIG{ALRM} = sub {
+ $SIG{__DIE__} = 'DEFAULT';
+ die "TIMEOUT\n";
+ };
+ alarm($timeout);
+
# cannot send standard HTTP Status-Code 400, because stupid
# Internet Explorer then refuses to display HTML body!
http_header("666 Bad Request - $msg");
$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} $_;
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";
" -a -e -r $bcc -r $to"
) or return;
- print {$po} $plain;
+ print {$po} "\n",$plain,"\n";
close $po;
$enc .= $_ while <$pi>;
$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".
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'
''
''
'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'
'$download'
'to download this file within $days.'
''
- '$comment'
'$autodelete'
''
'$disclaimer'
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";
}
projects / fex.git / blobdiff