# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#
-use CGI qw':standard';
-use CGI::Carp qw'fatalsToBrowser';
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
+
+use utf8;
use Fcntl qw':flock :seek';
use Cwd qw'abs_path';
use File::Basename;
our $error = 'F*EX download ERROR';
our $head = "$ENV{SERVER_NAME} F*EX download";
# import from fex.pp
-our ($spooldir,$tmpdir,$logdir,$skeydir,$dkeydir,$durl);
-our ($bs,$fop_auth,$timeout,$keep_default);
+our ($spooldir,$tmpdir,@logdir,$skeydir,$dkeydir,$durl);
+our ($bs,$fop_auth,$timeout,$keep_default,$nowarning);
our ($limited_download,$admin,$akey,$adlm,$amdl);
our (@file_link_dirs);
}
}
-my $log = "$logdir/fop.log";
+my $log = 'fop.log';
chdir $spooldir or die "$spooldir - $!\n";
if ($ENV{REQUEST_METHOD} eq 'GET' and $file =~ m:.+/(.+)/.+:) {
$from = lc $1;
- if (-s "$from/\@ALLOWED_RECIPIENTS") {
+ if (-s "$from/\@ALLOWED_RECIPIENTS") {
http_die("$from is a restricted user");
}
}
-
+
# add mail-domain to addresses if necessary
if ($mdomain and $file =~ s:(.+)/(.+)/(.+):$3:) {
$to = lc $1;
$from = lc $2;
+ $to =~ s/[:,].*//;
$to .= '@'.$hostname if $to eq 'anonymous';
$from .= '@'.$hostname if $from eq 'anonymous';
$to .= '@'.$mdomain if -d "$to\@$mdomain";
# workaround for broken F*IX
$qs =~ s/&ID=skey:\w+//;
-
+
# subuser with skey?
if ($qs =~ s/&*SKEY=([\w:]+)//i) {
$skey = $1;
http_die("wrong SKEY authentification");
}
}
-
+
# group member with gkey?
if ($qs =~ s/&*GKEY=([\w:]+)//i) {
$gkey = $1;
http_die("wrong GKEY authentification");
}
}
-
+
# check for ID in query
elsif ($qs =~ s/\&*\bID=([^&]+)//i) {
$id = $1;
$fop_auth = 0;
-
+
if ($id eq 'PUBLIC') {
http_header('403 Forbidden');
exit;
}
# public or anonymous recipient? (needs no auth-ID for sender)
- if ($anonymous or $id eq 'PUBLIC' and
+ if ($anonymous or $id eq 'PUBLIC' and
@public_recipients and grep /^\Q$to\E$/i,@public_recipients) {
$rid = $id;
} else {
close $idf;
$rid = sidhash($rid,$id);
}
-
+
unless ($id eq $rid) {
debuglog("real id=$rid, id sent by user=$id");
http_die("wrong auth-ID");
}
-
+
# set akey link for HTTP sessions
# (need original id for consistant non-moving akey)
if (-d $akeydir and open $idf,'<',"$from/@" and my $id = getline($idf)) {
unlink "$akeydir/$akey";
symlink "../$from","$akeydir/$akey";
}
-
+
my %to;
COLLECTTO: foreach my $to (split(',',$to)) {
if ($to !~ /.@./ and open my $AB,'<',"$from/\@ADDRESS_BOOK") {
http_die("$to is not a legal e-mail address");
}
}
-
+
}
-
+
if ($qs =~ /\&?KEEP=(\d+)/i) {
$keep = $1;
$filename = filename($file);
"</body></html>\n";
}
exit;
- } elsif ($qs =~ s/\&?KEEP//i) {
+ } elsif ($qs =~ s/\&?KEEP//i) {
check_captive($file);
$autodelete = 'NO';
}
-
+
if ($qs =~ s/\&?FILEID=(\w+)//i) { $fileid = $1 }
if ($qs =~ s/\&?IGNOREWARNING//i) { $ignorewarning = 1 }
-
+
if ($qs eq 'LIST') {
http_header('200 OK','Content-Type: text/plain');
print "$file :\n";
http_die("File $file already exists in your outgoing spool.");
}
mkdirp("$to/$to/$file");
- link "$to/$from/$file/data","$to/$to/$file/data"
+ link "$to/$from/$file/data","$to/$to/$file/data"
or http_die("cannot link to $to/$to/$file/data - $!\n");
my $fkey = copy("$to/$from/$file/filename","$to/$to/$file/filename");
open my $notify,'>',"$to/$to/$file/notify";
"</body></html>\n";
exit;
}
-
+
# ex and hopp?
if ($qs =~ s/(^|&)DELETE//i) {
if (unlink $data) {
$filename,$ENV{REMOTE_ADDR},isodate(time);
close $log;
}
- if (open $log,'>>',$log) {
- printf {$log}
- "%s [%s_%s] %s %s deleted\n",
- isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file);
- close $log;
+ foreach my $logdir (@logdir) {
+ my $msg = sprintf "%s [%s_%s] %s %s deleted\n",
+ isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file);
+ if (open $log,'>>',"$logdir/$log") {
+ print {$log} $msg;
+ close $log;
+ }
}
http_header('200 OK',"X-File: $file");
print html_header($head),
"<h3>$filename deleted</h3>\n",
"</body></html>\n";
exit;
- } else {
+ } else {
http_die("no such file");
}
exit;
- }
-
+ }
+
# wipe out!? (for anonymous upload)
if ($qs =~ s/(^|&)PURGE//i) {
$filename = filename($file);
if (@anonymous_upload and ipin($ra,@anonymous_upload)) {
unlink "$dkeydir/$dkey" if $dkey;
if (rmrf($file)) {
- if (open $log,'>>',$log) {
- printf {$log}
- "%s [%s_%s] %s %s purged\n",
- isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file);
- close $log;
+ foreach my $logdir (@logdir) {
+ my $msg = sprintf "%s [%s_%s] %s %s purged\n",
+ isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file);
+ if (open $log,'>>',"$logdir/$log") {
+ print {$log} $msg;
+ close $log;
+ }
}
http_header('200 OK',"X-File: $file");
print html_header($head),
"<h3>$filename purged</h3>\n",
"</body></html>\n";
- } else {
+ } else {
http_die("no such file");
}
- } else {
+ } else {
http_die("you are not allowed to purge $filename");
}
exit;
- }
-
+ }
+
# request for file size?
if ($qs eq '?') {
sendsize($file);
if (not $autodelete or $autodelete ne 'NO') {
$autodelete = readlink "$file/autodelete" || 'YES';
}
-
+
if ($from and $file eq "$from/$from/ADDRESS_BOOK") {
if (open my $AB,'<',"$from/\@ADDRESS_BOOK") {
my $ab = '';
# already downloaded?
if ($limited_download and $limited_download !~ /^n/i
and $from ne $to # fex to yourself is ok!
- and $to !~ /$amdl/ # allowed multi download recipients
and $from !~ /^_?fexmail/ # fexmail is ok!
and $to !~ /^_?fexmail/ # fexmail is ok!
and $to !~ /^anonymous/ # anonymous fex is ok!
+ and $to !~ /$amdl/ # allowed multi download recipients
and $http_client !~ /$adlm/ # allowed download managers
and $file !~ /\/STDFEX$/ # xx is ok!
and (slurp("$file/comment")||'') !~ /^!\*!/ # multi download allow flag
and not($dkey and ($ENV{HTTP_COOKIE}||'') =~ /dkey=$dkey/)
- and open $file,'<',"$file/download")
+ and open $file,'<',"$file/download")
{
- $_ = <$file> || '';
+ my $d1 = <$file> || ''; # first download
+ chomp $d1;
close $file;
- chomp;
if ($ra) {
# allow downloads from same ip
- $_ = '' if $ra eq $_;
+ $d1 = '' if $d1 =~ /\Q$ra/;
# allow downloads from sender ip
- $_ = '' if (readlink("$file/ip")||'') eq $ra;
+ $d1 = '' if (readlink("$file/ip")||'') eq $ra;
}
- if ($_) {
- s/(.+) ([\w.:]+)$/by $2 at $1/;
+ if ($d1 and $d1 =~ s/(.+) ([\w.:]+)$/$2 at $1/) {
$file = filename($file);
- http_die("$file has already been downloaded $_");
+ http_die("$file has already been downloaded by $d1");
}
}
$sb = sendfile($file,$seek,$stop);
isodate(time),$file,$sb||0,$seek,-s $data||0));
if ($sb+$seek == -s $data) {
-
+
# note successfull download
$download = "$file/download";
if (open $download,'>>',$download) {
printf {$download} "%s %s\n",isodate(time),$ENV{REMOTE_ADDR};
close $download;
}
-
+
# delete file after grace period
if ($autodelete eq 'YES') {
$grace_time = 60 unless defined $grace_time;
close $error;
}
}
-
+
}
exit;
-
+
sub sendfile {
my ($file,$seek,$stop) = @_;
my ($filename,$size,$total_size,$fileid,$filetype);
my ($data,$download,$header,$buf,$range,$s,$b,$t0);
my $type = '';
-
+
# swap to and from for special senders, see fup storage swap!
$file =~ s:^(_?anonymous_.*)/(anonymous.*)/:$2/$1/:;
$file =~ s:^(_?fexmail_.*)/(fexmail.*)/:$2/$1/:;
-
+
$data = $file.'/data';
$download = $file.'/download';
$header = $file.'/header';
-
+
# fallback defaults, should be set later with better values
$filename = filename($file);
$total_size = -s $data || 0;
}
}
$size = $total_size - $seek - ($stop ? $total_size-$stop-1 : 0);
- } elsif ($ENV{REQUEST_METHOD} eq 'HEAD') {
+ } elsif ($ENV{REQUEST_METHOD} eq 'HEAD') {
$size = -s $data || 0;
- } else {
+ } else {
http_die("unknown HTTP request method $ENV{REQUEST_METHOD}");
}
-
+
# read MIME entity header (what the client said)
if (open $header,'<',$header) {
while (<$header>) {
close $header;
$type =~ s/\s//g;
}
-
+
$fileid = readlink "$file/id" || '';
-
+
# determine own MIME entity header for download
my $mime = $file;
$mime =~ s:/.*:/\@MIME:;
}
# reset to default MIME type
else { $type = 'application/octet-stream' }
-
+
# HTML is not allowed for security reasons! (embedded javascript, etc)
$type =~ s/html/plain/i;
} else {
$range = sprintf("bytes %s-%s/%s",$seek,$total_size-1,$total_size);
}
+ # RFC 7233 "Responses to a Range Request"
nvt_print(
'HTTP/1.1 206 Partial Content',
"Content-Length: $size",
}
nvt_print('');
} else {
- # another stupid IE bug-workaround
+ # another stupid IE bug-workaround
# http://drupal.org/node/163445
# http://support.microsoft.com/kb/323308
- if ($http_client =~ /MSIE/) {
+ if ($http_client =~ /MSIE/ and not $nowarning) {
# $type = 'application/x-msdownload';
if ($ignorewarning) {
$type .= "; filename=$filename";
"Connection: close",
);
# nvt_print('','HTTP/1.1 200 OK',"Content-Length: $size","Content-Type: $type"); exit;
+ nvt_print($_) foreach(@extra_header);
} else {
http_header('200 OK');
print html_header($head);
if ($type eq 'application/octet-stream') {
nvt_print(qq'Content-Disposition: attachment; filename="$filename"');
}
+ nvt_print($_) foreach(@extra_header);
}
nvt_print("X-Size: $total_size");
# control back to fexsrv for further HTTP handling
&reexec;
}
-
+
if ($ENV{REQUEST_METHOD} eq 'GET') {
if (@throttle) {
$bwl = $limit;
last;
}
- }
+ }
# throttle e-mail address?
else {
# allow wildcard *, but not regexps
}
}
}
-
+
foreach my $sig (keys %SIG) { local $SIG{$sig} = \&sigexit }
local $SIG{ALRM} = sub { die "TIMEOUT\n" };
$b = $size-$s;
$buf = substr($buf,0,$b)
}
- $s += $b;
+ $s += $b;
alarm($timeout*10);
syswrite STDOUT,$buf or last; # client still alive?
if ($bwl) {
sleep 1 while $s/(time-$t0||1)/1024 > $bwl;
}
}
-
+
close $data;
alarm(0);
-
+
fdlog($log,$file,$s,$size);
}
close $download;
-
+
return $s;
}
my ($file,$upload,$to,$from,$dkey);
my $size = 0;
local $_;
-
+
$path =~ s:^/::;
($to,$from,$file) = split('/',$path);
$to =~ s/,.*//;
$to = lc $to;
$from = lc $from;
-
+
# swap to and from for special senders, see fup storage swap!
($from,$to) = ($to,$from) if $from =~ /^(fexmail|anonymous)/;
if ($to eq '*' and $fileid) {
foreach my $fd (glob "*/$from/$file") {
- if (-f "$fd/data"
+ if (-f "$fd/data"
and -l "$fd/id" and readlink "$fd/id" eq $fileid
and $dkey = readlink "$fd/dkey") {
$to = $fd;
}
close $AB;
}
-
+
if (-f "$to/$from/$file/data") {
$dkey = readlink "$to/$from/$file/dkey";
$fkey = slurp("$to/$from/$file/filename")||$file;
}
-
+
$upload = -s "$to/$from/$file/upload" || -s "$to/$from/$file/data" || 0;
$size = readlink "$to/$from/$file/size" || 0;
$fileid = readlink "$to/$from/$file/id" || '';
if ($path =~ m:(.+)/(.+)/(.+):) {
($to,$from,$file) = ($1,$2,$3);
- } elsif ($path =~ m:(.+)/(.+):) {
+ } elsif ($path =~ m:(.+)/(.+):) {
($dkey,$file) = ($1,$2);
$path = readlink "$dkeydir/$dkey" or http_die('no such file');
(undef,$to,$from,$file) = split('/',$path);
- } else {
+ } else {
http_die("wrong URL format for download");
}
debuglog("$user mismatch: id=$id, auth=$auth");
&require_auth;
}
- }
+ }
# check for sub user
elsif (open $idf,'<',"$from/\@SUBUSER") {
while (<$idf>) {
chomp;
s/#.*//;
($subuser,$subid) = split ':';
- if ($subid and $subid eq $auth
- and ($user eq $subuser
+ if ($subid and $subid eq $auth
+ and ($user eq $subuser
or $subuser eq '*@*'
or $subuser =~ /^\*\@(.+)/ and $user =~ /\@\Q$1\E$/i
or $subuser =~ /(.+)\@\*$/ and $user =~ /^\Q$1\E\@/i)) {
debuglog("no $to/@ and no $from/@");
&require_auth;
}
-
+
}
sub sigexit {
my ($sig) = @_;
my $msg;
-
+
$msg = @_ ? "@_" : '???';
$msg =~ s/\n/ /g;
$msg =~ s/\s+$//;
projects / fex.git / blobdiff