X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/7fa382617fbaccc0ce522b2b3adbbee9db5ad227..cdeb354c4dbb11b683f9f8c5db2861f3dc572c61:/cgi-bin/fop diff --git a/cgi-bin/fop b/cgi-bin/fop index 4370fb6..c5098fc 100755 --- a/cgi-bin/fop +++ b/cgi-bin/fop @@ -5,8 +5,9 @@ # Author: Ulli Horlacher # -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; @@ -20,8 +21,8 @@ die "$0: no $FEXLIB\n" unless -d $FEXLIB; 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); @@ -46,7 +47,7 @@ if ($0 !~ m{/locale/.*/fop} and my $lang = $ENV{HTTP_ACCEPT_LANGUAGE}) { } } -my $log = "$logdir/fop.log"; +my $log = 'fop.log'; chdir $spooldir or die "$spooldir - $!\n"; @@ -90,15 +91,16 @@ if ($file =~ m:^([^/]+)/[^/]+$:) { 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"; @@ -140,7 +142,7 @@ if ($qs = $ENV{QUERY_STRING}) { # workaround for broken F*IX $qs =~ s/&ID=skey:\w+//; - + # subuser with skey? if ($qs =~ s/&*SKEY=([\w:]+)//i) { $skey = $1; @@ -172,7 +174,7 @@ if ($qs = $ENV{QUERY_STRING}) { http_die("wrong SKEY authentification"); } } - + # group member with gkey? if ($qs =~ s/&*GKEY=([\w:]+)//i) { $gkey = $1; @@ -213,12 +215,12 @@ if ($qs = $ENV{QUERY_STRING}) { 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; @@ -241,7 +243,7 @@ if ($qs = $ENV{QUERY_STRING}) { } # 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 { @@ -250,12 +252,12 @@ if ($qs = $ENV{QUERY_STRING}) { 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)) { @@ -263,7 +265,7 @@ if ($qs = $ENV{QUERY_STRING}) { unlink "$akeydir/$akey"; symlink "../$from","$akeydir/$akey"; } - + my %to; COLLECTTO: foreach my $to (split(',',$to)) { if ($to !~ /.@./ and open my $AB,'<',"$from/\@ADDRESS_BOOK") { @@ -305,9 +307,9 @@ if ($qs = $ENV{QUERY_STRING}) { http_die("$to is not a legal e-mail address"); } } - + } - + if ($qs =~ /\&?KEEP=(\d+)/i) { $keep = $1; $filename = filename($file); @@ -332,15 +334,15 @@ if ($qs = $ENV{QUERY_STRING}) { "\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"; @@ -372,7 +374,7 @@ if ($qs = $ENV{QUERY_STRING}) { 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"; @@ -387,7 +389,7 @@ if ($qs = $ENV{QUERY_STRING}) { "\n"; exit; } - + # ex and hopp? if ($qs =~ s/(^|&)DELETE//i) { if (unlink $data) { @@ -397,48 +399,52 @@ if ($qs = $ENV{QUERY_STRING}) { $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), "

$filename deleted

\n", "\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), "

$filename purged

\n", "\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); @@ -505,7 +511,7 @@ if ($range = $ENV{HTTP_RANGE}) { 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 = ''; @@ -538,29 +544,28 @@ if (-f $data) { # 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); @@ -583,14 +588,14 @@ debuglog(sprintf("%s %s %d %d %d", 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; @@ -609,26 +614,26 @@ if ($sb+$seek == -s $data) { 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; @@ -671,12 +676,12 @@ sub sendfile { } } $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>) { @@ -688,9 +693,9 @@ sub sendfile { close $header; $type =~ s/\s//g; } - + $fileid = readlink "$file/id" || ''; - + # determine own MIME entity header for download my $mime = $file; $mime =~ s:/.*:/\@MIME:; @@ -713,7 +718,7 @@ sub sendfile { } # 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; @@ -729,6 +734,7 @@ sub sendfile { } 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", @@ -743,10 +749,10 @@ sub sendfile { } 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"; @@ -760,6 +766,7 @@ sub sendfile { "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); @@ -791,6 +798,7 @@ sub sendfile { 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"); @@ -809,7 +817,7 @@ sub sendfile { # control back to fexsrv for further HTTP handling &reexec; } - + if ($ENV{REQUEST_METHOD} eq 'GET') { if (@throttle) { @@ -825,7 +833,7 @@ sub sendfile { $bwl = $limit; last; } - } + } # throttle e-mail address? else { # allow wildcard *, but not regexps @@ -839,7 +847,7 @@ sub sendfile { } } } - + foreach my $sig (keys %SIG) { local $SIG{$sig} = \&sigexit } local $SIG{ALRM} = sub { die "TIMEOUT\n" }; @@ -855,7 +863,7 @@ sub sendfile { $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) { @@ -863,14 +871,14 @@ sub sendfile { sleep 1 while $s/(time-$t0||1)/1024 > $bwl; } } - + close $data; alarm(0); - + fdlog($log,$file,$s,$size); } close $download; - + return $s; } @@ -880,13 +888,13 @@ sub sendsize { 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)/; @@ -901,7 +909,7 @@ sub sendsize { 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; @@ -925,12 +933,12 @@ sub sendsize { } 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" || ''; @@ -996,11 +1004,11 @@ sub check_auth { 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"); } @@ -1024,15 +1032,15 @@ sub check_auth { 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)) { @@ -1049,7 +1057,7 @@ sub check_auth { debuglog("no $to/@ and no $from/@"); &require_auth; } - + } @@ -1066,7 +1074,7 @@ sub check_captive { sub sigexit { my ($sig) = @_; my $msg; - + $msg = @_ ? "@_" : '???'; $msg =~ s/\n/ /g; $msg =~ s/\s+$//;