X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/7fa382617fbaccc0ce522b2b3adbbee9db5ad227..refs/heads/master:/cgi-bin/fup?ds=inline diff --git a/cgi-bin/fup b/cgi-bin/fup index d43cda0..9ba0ef2 100755 --- a/cgi-bin/fup +++ b/cgi-bin/fup @@ -8,20 +8,17 @@ # Sebastian Zaiser (upload status) # +BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 } + +use utf8; use Encode; use Fcntl qw':flock :seek :mode'; use IO::Handle; use Digest::MD5 qw'md5_hex'; -use CGI::Carp qw'fatalsToBrowser'; use Cwd qw'abs_path'; -use constant DS => 60*60*24; -use constant M => 1024*1024; - # add fex lib -die "$0: no \$FEXLIB\n" unless $ENV{FEXLIB}; (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/; -die "$0: no $FEXLIB\n" unless -d $FEXLIB; $| = 1; @@ -39,10 +36,12 @@ our (@registration_hosts,@demo,@file_link_dirs); # import from fex.pp our ($FEXHOME); -our ($spooldir,$durl,$tmpdir,$logdir,$docdir,$hostname,$admin,$fra); -our ($keep_default,$recipient_quota,$sender_quota); -our ($sendmail,$mdomain,$fop_auth,$mail_auth,$faillog); +our ($spooldir,$durl,$tmpdir,@logdir,$logdir,$docdir,$hostname,$admin,$fra); +our ($keep_default,$recipient_quota,$sender_quota,$fex_yourself); +our ($sendmail,$mdomain,$fop_auth,$mail_auth,$faillog,$amdl); our ($dkeydir,$ukeydir,$akeydir,$skeydir,$gkeydir,$xkeydir); +our ($MB,$DS); +our $RB; # read POST bytes (total) our $akey = ''; our $dkey = ''; our $skey = ''; @@ -54,26 +53,26 @@ our $fpsize = 0; # file part size (MIME-part) my $data; my $boundary; -my $rb = 0; # read bytes, totally my $rid = ''; # real ID my @header; # HTTP entity header my $fileid; # file ID my $captive; my $muser; # main user fur sub or group user - +my %specific; # upload specific KEEP and AUTODELETE parameters + # load common code, local config: $FEXLIB/fex.ph -require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n"; +require "$FEXLIB/fex.pp"; # load fup local config our ($info_1,$info_2,$info_login); $locale = $ENV{LOCALE} || 'english'; -foreach my $pl ( - "/var/lib/fex/locale/$locale/lib/fup.pl", +foreach ( + "/var/lib/fex/locale/$locale/lib/fup.pl", "$FEXLIB/fup.pl", ) { - if (-f $pl) { - require $pl or die "$0: cannot load $FEXLIB/fup.pl - $!\n"; + if (-f) { + require; last; } } @@ -82,7 +81,7 @@ foreach my $pl ( chdir $spooldir or http_die("$spooldir - $!\n"); -my $log = "$logdir/fup.log"; +my $log = 'fup.log'; my $http_client = $ENV{HTTP_USER_AGENT} || ''; my $cl = $ENV{X_CONTENT_LENGTH} || $ENV{CONTENT_LENGTH} || 0; @@ -111,11 +110,16 @@ if ($addto) { my %to; foreach $to (@to) { $to{$to} = 1 } push @to,$addto unless $to{$addto}; - if ($submit and @to == 1) { $addto = '' } + # user has submitted with [select from your address book] ? + # if ($submit and @to == 1) { $addto = '' } } $to = join(',',@to); +if ($from eq $to and $fex_yourself =~ /^no|0$/i) { + http_die("fexing to yourself is not allowed"); +} + $uid = randstring(8) unless $uid; # upload ID # user requests for forgotten ID @@ -128,7 +132,7 @@ if ($from and $id_forgotten and $mail_authid and not ($fop_auth or $nomail)) { # public recipients? (needs no auth-ID for sender) if ($to and $id and $id eq 'PUBLIC' and @public_recipients) { - + unless ($from) { http_die("missing sender e-mail address"); } @@ -145,12 +149,12 @@ if ($to and $id and $id eq 'PUBLIC' and @public_recipients) { } # anonymous upload from enabled IP? -if ($from =~ /^anonymous@/ and +if ($from =~ /^anonymous@/ and @anonymous_upload and ipin($ra,@anonymous_upload)) { $id = $rid = $anonymous = 'anonymous'; if ($to =~ /^anonymous/) { @to = ($to); - $autodelete{$to} = $autodelete = 'NO'; + $autodelete{$to} = $autodelete = $specific{'autodelete'}||'NO'; } $nomail = $anonymous; } @@ -160,7 +164,7 @@ $comment = 'NOMAIL' if $nomail and not $comment; # one time token if ($okey) { $to = "@to" or http_die("no recipient specified"); - $from = readlink "$to/\@OKEY/$okey" + $from = readlink "$to/\@OKEY/$okey" or http_die("no upload key \"$okey\" - ". "request another one from $to"); $from = untaint($from); @@ -198,10 +202,9 @@ if ($from and $id and not ($gkey or $skey or $public or $okey)) { # 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)) { - $akey = untaint(md5_hex("$from:$id")); - mksymlink("$akeydir/$akey","../$from"); - # show URL from fexsend - if ($from eq $to and $comment eq '*') { + # akey for webbrowser or fexsend special + if (not $sid or ($from eq $to and ($comment eq '*')) or $command) { + $akey = untaint(md5_hex("$from:$id")); mksymlink("$akeydir/$akey","../$from"); } } @@ -214,6 +217,11 @@ if ($from and $id and not ($gkey or $skey or $public or $okey)) { } } +# optional $auth_hook() in fup.pl +if ($auth_hook and ($akey or $skey or $gkey) and $from and -d $from) { + &$auth_hook; +} + # forward a copy of a file to another recipient if ($akey and $dkey and $command eq 'FORWARD') { my $file = untaint(readlink "$dkeydir/$dkey"||''); @@ -246,12 +254,12 @@ if ($akey and $dkey and $command eq 'COPY') { http_die("File not found"); } if (-e "$to/$to/$file/data") { - http_die("File $file already exists in your outgoing spool") - if (readlink("$to/$to/$file/id")||$to) ne + http_die("File $file already exists in your outgoing spool") + if (readlink("$to/$to/$file/id")||$to) ne (readlink("$to/$from/$file/id")||$from); } else { 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"); copy("$to/$from/$file/filename","$to/$to/$file/filename"); copy("$to/$from/$file/id","$to/$to/$file/id"); @@ -296,7 +304,7 @@ if ($akey and $dkey and $command eq 'DELETE') { "" ); &reexec; - } else { + } else { my $s = $!; http_header('404 Not Found'); print html_header($head); @@ -309,7 +317,7 @@ if ($akey and $dkey and $command eq 'DELETE') { # special commands if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { - + if ($command eq 'CHECKQUOTA') { http_die("illegal command \"$command\"") if $public or $anonymous; nvt_print('HTTP/1.1 204 OK'); @@ -371,7 +379,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { next if $file =~ m:(.+?)/: and -l $1; $size = -s "$file/data"; next unless $size; - $size = int($size/M+0.5); + $size = int($size/$MB+0.5); $filename = $comment = ''; my $rto = $file; $rto =~ s:/.*::; @@ -384,9 +392,9 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { $filename = <$file>; close $file; } - if ($filename and length $filename) { + if ($filename and length $filename) { $filename = html_quote($filename); - } else { + } else { $filename = '???'; } if (open $file,'<',"$file/comment") { @@ -394,23 +402,23 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { close $file; } my $rkeep = untaint(readlink "$file/keep"||$keep_default) - - int((time-mtime("$file/filename"))/DS); - if ($comment =~ /NOMAIL/ or + - int((time-mtime("$file/filename"))/$DS); + if ($comment =~ /NOMAIL/ or (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) { - printf "%8s MB [%s d] %s/%s/%s\n", + printf "%8s MB (%2s d) %s/%s/%s\n", $size, $rkeep, $durl, $dkey, urlencode(basename($file)); } else { - printf "%8s MB [%s d] %s%s %s\n", + printf "%8s MB (%2s d) %s%s %s\n", $size, $rkeep, untaint("/fup?akey=$akey&dkey=$dkey&command=RENOTIFY"), $filename, $comment ? qq' "$comment"' : '', - $file eq $nfile ? + $file eq $nfile ? " → notification e-mail has been resent" : ""; } @@ -422,7 +430,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { '' )); exit; - } + } if ($command =~ /^LIST(RECEIVED)?$/) { http_die("illegal command \"$command\"") if $public or $anonymous; @@ -438,11 +446,12 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { next if $file =~ m:(.+?)/: and -l $1; $size = -s "$file/data"; next unless $size; - $size = int($size/M+0.5); + $size = int($size/$MB+0.5); $filename = $comment = ''; my $rto = $file; $rto =~ s:/.*::; if ($dkey = readlink "$file/dkey") { + # die $file if -s "$file/data" and $file =~ /^$from/; if ($rto ne $to) { $to = $rto; print "\nto $to :\n"; @@ -451,20 +460,21 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { $filename = <$file>; close $file; } - if ($filename and length $filename) { + if ($filename and length $filename) { $filename = html_quote($filename); - } else { + } else { $filename = '???'; } if (open $file,'<',"$file/comment") { $comment = untaint(html_quote(getline($file))); close $file; } - my $rkeep = untaint(readlink "$file/keep"||$keep_default) - - int((time-mtime("$file/filename"))/DS); - printf "%8s MB [%s d] %s%s\n", + my $rkeep = untaint(readlink "$file/keep"||$keep_default) + - int((time-mtime("$file/filename"))/$DS); + printf "%8s MB (%2s d) %s %s%s\n", $size, $rkeep, + stat("$file/download")?'+':'-', untaint("/fup?akey=$akey&dkey=$dkey&command=FORWARD"), $filename, $comment?qq( "$comment"):''; @@ -475,7 +485,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { '

back to F*EX operation control' '' )); - } + } # list received files else { $to = $from; @@ -493,7 +503,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { $filename = $comment = ''; $size = -s "$file/data"; next unless $size; - $size = int($size/M+0.5); + $size = int($size/$MB+0.5); if ($dkey = readlink "$file/dkey") { print "\nfrom $from :\n" unless $url; $file =~ m:.*/(.+):; @@ -505,9 +515,9 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { $filename = <$file>; close $file; } - if ($filename and length $filename) { + if ($filename and length $filename) { $filename = html_quote($filename); - } else { + } else { $filename = '???'; } if (open $file,'<',"$file/comment") { @@ -515,13 +525,13 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { $comment = ' "'.$comment.'"'; close $file; } - my $rkeep = untaint(readlink "$file/keep"||$keep_default) - - int((time-mtime("$file/filename"))/DS); + my $rkeep = untaint(readlink "$file/keep"||$keep_default) + - int((time-mtime("$file/filename"))/$DS); printf "[delete] ", $akey,$dkey; printf "[forward] ", $akey,$dkey; - printf "%8s MB (%s d) %s%s\n", + printf "%8s MB (%2s d) %s%s\n", $size,$rkeep,$url,$filename,$comment; } } @@ -534,11 +544,11 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { )); } exit; - } - + } + if ($command eq 'LISTSENT') { http_die("illegal command \"$command\"") if $public or $anonymous; - # show download URLs + # show download URLs http_header('200 OK'); print html_header($head); print "

Download URLs of files you have sent\n"; @@ -564,7 +574,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { )); exit; } - + if ($command eq 'FOPLOG') { http_die("illegal command \"$command\"") if $public or $anonymous; if (open my $log,"$logdir/fop.log") { @@ -581,14 +591,14 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { } exit; } - + if ($command eq 'RECEIVEDLOG') { http_die("illegal command \"$command\"") if $public or $anonymous; - if (open my $fuplog,"$logdir/fup.log") { + if (open my $log,"$logdir/fup.log") { http_header('200 OK'); - while (<$fuplog>) { + while (<$log>) { next if /\sSTDFEX\s/; - if (/\d+$/) { + if (/\d+$/) { my @F = split; if ($F[5] eq $to) { s/ \[[\d_]+\]//; @@ -602,11 +612,11 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { if ($command eq 'SENDLOG') { http_die("illegal command \"$command\"") if $public or $anonymous; - if (open my $fuplog,"$logdir/fup.log") { + if (open my $log,"$logdir/fup.log") { http_header('200 OK'); - while (<$fuplog>) { + while (<$log>) { next if /\sSTDFEX\s/; - if (/(\S+\@\S+)/ and $1 eq $from) { + if (/(\S+\@\S+)/ and $1 eq $from) { s/ \[[\d_]+\]//; print; } @@ -623,11 +633,12 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { foreach my $to (@group?@group:@to) { # my $options = sprintf "(autodelete=%s,keep=%s,locale=%s)", # readlink "$to/\@LOCALE"||$locale||$locale{$to}||$default_locale; - my $options = sprintf "(autodelete=%s,keep=%s,locale=%s,notification=%s)", + # my $options = sprintf "(autodelete=%s,keep=%s,locale=%s,notification=%s)", + my $options = sprintf "(autodelete=%s,keep=%s,locale=%s)", $autodelete{$to}||$autodelete, $keep{$to}||$keep_default, - readlink("$to/\@LOCALE")||$default_locale, - readlink("$to/\@NOTIFICATION")||'full'; + readlink("$to/\@LOCALE")||$locale{$to}||$default_locale; + # readlink("$to/\@NOTIFICATION")||'full'; nvt_print("X-Recipient: $to $options"); } nvt_print(''); @@ -649,7 +660,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { http_die("illegal parameter $del"); } $del = untaint($del); - + if (unlink("$del/data") or unlink("$del/upload")) { if (open F,'>',"$del/error") { print F "$file has been deleted by $from\n"; @@ -658,7 +669,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { http_header('200 OK',"X-File: $del"); print html_header($head); print "

$file deleted

\n"; - } else { + } else { http_header("404 Not Found"); print html_header($head); print "

$file not deleted

\n"; @@ -688,20 +699,20 @@ if ($from and $id and $rid eq $id and open my $ipr,"$from/\@UPLOAD_HOSTS") { } } -# quotas +# quotas if ($from and $id and $rid eq $id and @to and not $flink and not $seek) { my ($quota,$du); - + # check sender quota ($quota,$du) = check_sender_quota($muser||$from); - if ($quota and $du+$cl/M > $quota) { + if ($quota and $du+$cl/$MB > $quota) { http_die("you are overquota"); } - + # check recipient quota foreach my $to (@to) { ($quota,$du) = check_recipient_quota($to); - if ($quota and $du+$cl/M > $quota) { + if ($quota and $du+$cl/$MB > $quota) { http_die("$to cannot receive files: is overquota"); } } @@ -717,15 +728,14 @@ if ($id and $id eq $rid and $from and @to and not $public) { # (= has a F*EX ID) if (not $addto and $fop_auth and $id and $id eq $rid and $from and @to) { my ($to_reg,$idf,$subuser); - foreach (@to) { - my $to = $_; + foreach my $to (my @loop = @to) { $to =~ s/:\w+=.*//; # remove options from address $to_reg = 0; # full user? if (open $idf,'<',"$to/@") { $to_reg = getline($idf); close $idf; - } + } # sub user? elsif (open $idf,'<',"$from/\@SUBUSER") { while (<$idf>) { @@ -749,7 +759,7 @@ if (not $addto and $fop_auth and $id and $id eq $rid and $from and @to) { } $to = join(',',@to); - + if ($to =~ /^@(.+)/) { if ($nomail) { http_die("server runs in NOMAIL mode - groups ($to) are not allowed"); @@ -782,20 +792,20 @@ if ($from and $id and $id eq $rid and $faillog) { # display HTML form and request user data unless ($file) { - if ($test) { $cgi = $test } + if ($test) { $cgi = $test } else { $cgi = $ENV{SCRIPT_NAME} } $cgi = 'fup'; - + # delete old cookies on logout referer my @cookies; if ($logout and my $cookie = $ENV{HTTP_COOKIE}) { while ($cookie =~ s/(\w+key)=\w+//) { - push @cookies,"Set-Cookie: $1=; Max-Age=0; Discard"; + push @cookies,"Set-Cookie: $1=x; path=/; expires=Thu, 01 Jan 1970 00:00:00 GMT"; } } - - # save default locale for this user + if (($akey or $skey or $gkey) and $from and -d $from) { + # save default locale for this user if (not $locale and ($ENV{HTTP_COOKIE}||'') =~ /\blocale=(\w+)/) { $locale = $1; } @@ -805,7 +815,7 @@ unless ($file) { http_header('200 OK',@cookies); # print html_header($head,''); print html_header($head); - + if ($http_client =~ /(Konqueror|w3m)/) { pq(qq( '

' @@ -818,11 +828,11 @@ unless ($file) { } # default "fex yourself" setting? - if ($from and $id and $id eq $rid and not $addto + if ($from and $id and $id eq $rid and not $addto and not ($gkey or $skey or $okey or $public or $anonymous) and (not @to or "@to" eq $from) and -f "$from/\@FEXYOURSELF") - { + { @to = ($from); $nomail = 'fexyourself'; } @@ -832,22 +842,25 @@ unless ($file) { and not ($gkey or $skey or $okey or $public or $anonymous)) { present_locales('/fup'); - + + # print "[$addto] [$submit] [@to]

\n"; + @ab = (""); - + # select menu from server address book - if (open my $ab,'<',"$from/\@ADDRESS_BOOK") { - while (<$ab>) { + if (open my $AB,'<',"$from/\@ADDRESS_BOOK") { + while (<$AB>) { s/#.*//g; if (/(\S+)[=\s]+(\S+@[\w.-]+\S*)/) { $_ = "$1 <$2>"; s/,.*/,.../g; + s/:.*/>/; push @ab,""; } } - close $ab; + close $AB; } - + unless (@to) { unless ($nomail) { foreach (glob "$from/\@GROUP/*") { @@ -858,7 +871,7 @@ unless ($file) { } } } - + my $ab64 = b64("from=$from&id=$id"); # '

' ' ' ' ' - ' ' + ' ' '
sender: $from
sender: $from
recipient(s):' '
' )); @@ -902,6 +915,11 @@ unless ($file) { foreach my $rd (@local_rdomains) { print "*\@$rd\n"; } + } elsif (/^\@LOCAL_USERS/) { + foreach (glob "*/@") { + s:/.::; + print "$_\n"; + } } else { print "$_\n"; } @@ -909,25 +927,24 @@ unless ($file) { print "

\n"; close $rr; } - pq(qq( - ' ' - ' or ' - '' - '

' - )); + print qq' '; + if ($fex_yourself =~ /^yes|1/i) { + print qq' or ' + } + print "\n\n

\n"; if ($akey and -f "$from/\@" and not $captive ) { pq(qq( 'user config & operation control' )); } - + if ($from eq $admin ) { pq(qq( '

' 'server config & admin control' )); } - + if (0 and -f "$docdir/FIX.jar") { print "

\n"; if ($public) { print "" } @@ -937,30 +954,39 @@ unless ($file) { print "Alternate Java client (for files > 2 GB or sending of more than one file)\n"; } print &logout; - if (-x "$FEXHOME/cgi-bin/login") { - print $info_login||$info_1; - } - print "\n"; + pq(qq( + '

' + '' + 'Warning: the recipient must not be a mailing list,' + 'because after download the file will be no more available!' + '
' + 'Contact fexmaster if you want to fex to a mailing list,' + 'he can allow multiple downloads for specific addresses.' + '

' + 'Use a F*EX client if you want to send more than one file or resume an interrupted upload.' + '' + '

' + )); + print $info_1; exit; - } - + } + # ask for filename if ($from and ($id or $okey)) { $to = $group if $group; present_locales($ENV{REQUEST_URI}) if $skey or $gkey or $okey; +# " '$ENV{PROTO}://$ENV{HTTP_HOST}/$cgi?showstatus=$uid'," pq(qq( '\n"; exit; @@ -1806,7 +1906,7 @@ sub showstatus { "no file data received - does your file exist or is it >2GB?") } html_error($error,"file size unknown") unless $tsize =~ /^\d+$/; - + http_header('200 OK'); if (open $ukey,'<',"$ukey/filename") { local $/; @@ -1814,14 +1914,14 @@ sub showstatus { close $ukey; } http_die("no filename?!") unless $file; - + my $ssize = $tsize; if ($ssize<2097152) { $ssize = sprintf "%d kB",int($ssize/1024); } else { $ssize = sprintf "%d MB",int($ssize/1048576); } - + pq(qq( "" "

" @@ -1833,7 +1933,7 @@ sub showstatus { "
" "
" )); - + # wait for upload file for (1..9) { last if -f $upload or -f $data; @@ -1844,13 +1944,16 @@ sub showstatus { print $wclose; exit; } - - $SIG{ALRM} = sub { die "TIMEOUT in showstatus: no (more) data received\n" }; + + $SIG{ALRM} = sub { + $SIG{__DIE__} = 'DEFAULT'; + die "TIMEOUT in showstatus: no (more) data received\n"; + }; alarm($timeout*2); - + $t0 = $t1 = time; $osize = $percent = $npercent = 0; - + for ($percent = 0; $percent<100; sleep(1)) { $t2 = time; $nsize = -s $upload; @@ -1874,7 +1977,7 @@ sub showstatus { # so, updating more often is contra-productive if ($t2>$t1+5 or $npercent>$percent) { $percent = $npercent; - $t1 = $t2; + $t1 = $t2; $tm = int(($t2-$t0)/60); $ts = $t2-$t0-$tm*60; $tt = sprintf("%d:%02d",$tm,$ts); @@ -1886,7 +1989,7 @@ sub showstatus { )) or last; } } - + alarm(0); if ($npercent == 100) { print "

file successfully transferred

\n"; @@ -1931,26 +2034,26 @@ sub get_file { http_die("$filed locked: a download is currently in progress"); } } - + # prepare upload foreach $to (@to) { $to =~ s/:\w+=.*//; # remove options from address $filed = "$to/$from/$fkey"; $nupload = "$filed/upload"; # upload for next recipient mkdirp($filed); - + # upload already prepared (for first recipient)? if ($upload) { # link upload for next recipient unless ($upload eq $nupload or -r $upload and -r $nupload and - (stat $upload)[1] == (stat $nupload)[1]) + (stat $upload)[1] == (stat $nupload)[1]) { unlink $nupload; link $upload,$nupload; } - } - + } + # first recipient => create upload else { $upload = $nupload; @@ -2002,7 +2105,7 @@ sub get_file { symlink "../$filed","$ukeydir/$uid"; } } - + unlink "$filed/autodelete", "$filed/error", "$filed/restrictions", @@ -2014,10 +2117,11 @@ sub get_file { "$filed/speed", "$filed/replyto", "$filed/useragent", + "$filed/uurl", "$filed/comment", "$filed/notify"; unlink "$filed/size" unless $seek; - + # showstatus needs file name and size # fexsend needs full file size (+$seek) $fh = "$filed/filename"; @@ -2026,24 +2130,29 @@ sub get_file { close $fh; if ($::filesize > 0 or $cl > 0) { if ($::filesize > 0) { $filesize = $fpsize || $::filesize } - else { $filesize = $cl-$rb-$ebl+$seek } + else { $filesize = $cl-$RB-$ebl+$seek } # new file unless ($seek) { if ($::filesize > 0) { # total file size as reported by POST - mksymlink("$filed/size",$::filesize) + mksymlink("$filed/size",$::filesize) or die "cannot write $filed/size - $!\n"; } else { # file size as counted - mksymlink("$filed/size",$filesize) + mksymlink("$filed/size",$filesize) or die "cannot write $filed/size - $!\n"; } } } - - $autodelete{$to} = $autodelete unless $autodelete{$to}; - if ($autodelete{$to} =~ /^(DELAY|NO|\d+)$/i) { - mksymlink("$filed/autodelete",$autodelete{$to}); + + if ($from eq "@to") { + # special "fex yourself" + mksymlink("$filed/autodelete",$specific{'autodelete'}||'NO'); + } else { + $autodelete{$to} = $autodelete unless $autodelete{$to}; + if ($autodelete{$to} =~ /^(DELAY|NO|\d+)$/i) { + mksymlink("$filed/autodelete",$autodelete{$to}); + } } if (my $keep = $keep{$to} || $::keep) { @@ -2051,6 +2160,9 @@ sub get_file { } mksymlink("$filed/id",$fileid) if $fileid; mksymlink("$filed/ip",$ra) if $ra; + if (my $uurl = $ENV{REQUEST_URL}) { + mksymlink("$filed/uurl",$uurl); + } if ($http_client and open $http_client,'>',"$filed/useragent") { print {$http_client} $http_client,"\n"; close $http_client; @@ -2065,24 +2177,24 @@ sub get_file { if ($replyto and $replyto =~ /.@./) { mksymlink("$filed/replyto",$replyto); } - + my $arh = "$from/\@ALLOWED_RHOSTS"; if (-s $arh) { copy($arh,"$filed/restrictions"); } - + if (@header and open $fh,'>',"$filed/header") { print {$fh} join("\n",@header),"\n"; close $fh; } - + if ((readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) { $nomail{$to} = 'NOTIFICATION'; } if ($nomail) { open $fh,'>',"$filed/notify" and close $fh; - } + } if ($comment) { if (open $fh,'>',"$filed/comment") { print {$fh} encode_utf8($comment); @@ -2094,17 +2206,17 @@ sub get_file { unless ($dkey = readlink("$filed/dkey") and -l "$dkeydir/$dkey") { $dkey = randstring(8); unlink "$dkeydir/$dkey"; - symlink "../$filed","$dkeydir/$dkey" + symlink "../$filed","$dkeydir/$dkey" or http_die("cannot symlink $dkeydir/$dkey ($!)"); unlink "$filed/dkey"; symlink $dkey,"$filed/dkey"; } - + } # extra download (XKEY)? if ($anonymous and $fkey =~ /^afex_\d/ or - $from eq "@to" and $comment =~ s:^//(.*)$:NOMAIL:) + $from eq "@to" and $comment =~ s:^//(.*)$:NOMAIL:) { $xkey = $1||$fkey; $nomail = $comment; @@ -2113,15 +2225,15 @@ sub get_file { if (-e $x) { http_die("extra download key $xkey already exists"); } - symlink "../$from/$from/$fkey",$x + symlink "../$from/$from/$fkey",$x or http_die("cannot symlink $x - $!\n"); unlink "$x/xkey"; symlink $xkey,"$x/xkey"; } } - + } - + # file link? if ($flink) { # upload link has been already created, no data to read any more @@ -2135,52 +2247,53 @@ sub get_file { # at last, read (real) file data $t0 = time(); - + # streaming data? if ($cl == -1) { alarm($timeout*2); # read until EOF, including MIME end boundary + # note: cannot use sysread because of previous buffered read! while ($n = read(STDIN,$_,$bs)) { - $rb += $n; + $RB += $n; $fb += $n; syswrite $upload,$_ unless $nostore; alarm($timeout*2); } # size of transferred file, without end boundary $ndata = untaint($fb-$ebl); - } - + } + # normal file with known file size else { - + if ($fpsize) { debuglog(sprintf("still awaiting %d+%d = %d bytes", $fpsize,$ebl,$fpsize+$ebl)); - $cl = $rb+$fpsize+$ebl; # recalculate CONTENT_LENGTH + $cl = $RB+$fpsize+$ebl; # recalculate CONTENT_LENGTH } else { if ($::filesize) { - $cl = $rb+$::filesize+$ebl; # recalculate CONTENT_LENGTH + $cl = $RB+$::filesize+$ebl; # recalculate CONTENT_LENGTH } debuglog(sprintf("still awaiting %d-%d = %d bytes", - $cl,$rb,$cl-$rb)); + $cl,$RB,$cl-$RB)); } # read until end boundary, not EOF - while ($rb < $cl-$ebl) { - $b = $cl-$ebl-$rb; + while ($RB < $cl-$ebl) { + $b = $cl-$ebl-$RB; $b = $bs if $b > $bs; # max wait for 1 kB/s, but at least 10 s # $timeout = $b/1024; # $timeout = 10 if $timeout < 10; alarm($timeout); if ($n = read(STDIN,$_,$b)) { - $rb += $n; + $RB += $n; $fb += $n; # syswrite is much faster than print syswrite $upload,$_ unless $nostore; if ($bwlimit) { alarm(0); $tt = (time-$t0) || 1; - while ($rb/$tt/1024 > $bwlimit) { + while ($RB/$tt/1024 > $bwlimit) { sleep 1; $tt = time-$t0; } @@ -2198,19 +2311,19 @@ sub get_file { http_die("found no MIME end boundary in upload ($_)"); } } - $rb += $ebl; + $RB += $ebl; $ndata = untaint($fb); - } + } alarm(0); - + unless ($nostore) { close $upload; # or die "cannot close $upload - $!\n";; - + # throuput in kB/s $tt = (time-$t0) || 1; mksymlink("$filed/speed",int($fb/1024/$tt)); - + unless ($ndata) { http_die( "No file data received!". @@ -2218,12 +2331,12 @@ sub get_file { " File too big (browser-limit: 2 GB!)?" ); } - + $to = join(',',@to); - + # streaming upload? if ($cl == -1) { - + open $upload,'<',$upload or http_die("internal error - cannot read upload"); seek $upload,$ndata+2,0; $_ = <$upload>||''; @@ -2232,34 +2345,34 @@ sub get_file { } close $upload; truncate $upload,$ndata; - + } else { - + # truncate boundary string # truncate $upload,$ndata+$uss if -s $upload > $ndata+$uss; - + # incomplete? - if ($cl != $rb) { + if ($cl != $RB) { fuplog($to,$fkey,$ndata,'(aborted)'); if ($fpsize) { - http_die("read $rb bytes, but Content-Length announces $fpsize bytes"); + http_die("read $RB bytes, but Content-Length announces $fpsize bytes"); } else { - http_die("read $rb bytes, but CONTENT_LENGTH announces $cl bytes"); + http_die("read $RB bytes, but CONTENT_LENGTH announces $cl bytes"); } } - + # multipost, not complete if ($::filesize > -s $upload) { http_header('206 Partial OK'); exit; } - + # save error? if (-s $upload > ($::filesize||$filesize)) { fuplog($to,$fkey,$ndata,'(write error: upload > filesize)'); http_die("internal server error while writing file data"); } - + } fuplog($to,$fkey,$ndata); debuglog("upload successfull, dkey=$dkey"); @@ -2274,7 +2387,7 @@ sub check_rr { my @to = @_; my $rr = "$from/\@ALLOWED_RECIPIENTS"; my ($allowed,$to,$ar,$rd); - + if (-s $rr and open $rr,'<',$rr) { $restricted = $rr; @@ -2287,7 +2400,7 @@ sub check_rr { chomp; s/#.*//; s/\s//g; - + if (/^\@LOCAL_RDOMAINS/) { $ar = '(@'; foreach (@local_rdomains) { @@ -2298,26 +2411,29 @@ sub check_rr { $ar .= '|[^\@]+\@' . $rd; } $ar .= ')'; + } elsif (/^\@LOCAL_USERS/ and -s "$to/@") { + $allowed = 1; + last; } else { # allow wildcard *, but not regexps $ar = quotemeta $_; $ar =~ s/\\\*/[^@]*/g; } - + if ($to =~ /^$ar$/i) { $allowed = 1; last; } - + } - + unless ($allowed) { fuplog("ERROR: $from not allowed to fex to $to"); debuglog("$to not in $spooldir/$from/\@ALLOWED_RECIPIENTS"); http_die("You ($from) are not allowed to fex to $to"); } } - + close $rr; } } @@ -2327,25 +2443,24 @@ sub check_rr { sub expand { my @users = @_; my @ua; - - foreach (@users) { - my $u = $_; - if ($u =~ /^anonymous(_\d+)?$/) { + + foreach my $u (my @loop = @users) { + if ($u =~ /^anonymous(_\d+)?$/) { $u = "$u\@$hostname"; } - if ($u eq 'nettest') { + if ($u eq 'nettest') { if ($mdomain and -d "$u\@$mdomain") { $u .= "\@$mdomain" } elsif (-d "$u\@$hostname") { - $u .= "\@$hostname" + $u .= "\@$hostname" } } - if ($u =~ /@/) { push @ua,$u } - elsif ($mdomain) { push @ua,"$u\@$mdomain" } - elsif (-d "$u\@$hostname") { push @ua,"$u\@$hostname" } + if ($u =~ /@/) { push @ua,$u } + elsif ($mdomain) { push @ua,"$u\@$mdomain" } + elsif (-d "$u\@$hostname") { push @ua,"$u\@$hostname" } else { push @ua,$u } } - + return wantarray ? @ua : join(',',@ua); } @@ -2354,11 +2469,14 @@ sub expand { sub forward { my $file = shift; my ($nfile,$to,$AB); - my ($filename); + my ($filename,$keep); my (%to); http_die("no file data for $file") unless -f "$file/data"; + $keep = $::keep||$keep_default; + if (my $mt = mtime("$file/data")) { $keep += int((time-$mt)/$DS) } + if (@to) { # check recipients restriction @@ -2381,8 +2499,7 @@ sub forward { } # collect addresses - foreach (@to) { - my $to = $_; + foreach my $to (my @loop = @to) { if ($ab{$to}) { foreach my $address (@{$ab{$to}}) { $to{$address} = $address; @@ -2393,13 +2510,12 @@ sub forward { } } + @to = keys %to; + http_header('200 OK'); print html_header($head); - @to = keys %to; - - foreach (@to) { - my $to = $_; + foreach my $to (my @loop = @to) { $to =~ s/:\w+=.*//; # remove options from address $nfile = $file; $nfile =~ s:.*?/:$to/:; @@ -2425,26 +2541,26 @@ sub forward { close $comment; } if ($autodelete =~ /^(DELAY|NO|\d+)$/i) { - symlink($autodelete,"$nfile/autodelete"); - } - symlink($keep||$keep_default, "$nfile/keep"); - copy("$file/id", "$nfile/id"); - copy("$file/ip", "$nfile/ip"); - copy("$file/speed", "$nfile/speed"); - copy("$file/replyto", "$nfile/replyto"); - $filename = copy("$file/filename", "$nfile/filename"); - link "$file/data", "$nfile/data" + symlink $autodelete,"$nfile/autodelete"; + } + symlink $keep, "$nfile/keep"; + copy("$file/id", "$nfile/id"); + copy("$file/ip", "$nfile/ip"); + copy("$file/speed", "$nfile/speed"); + copy("$file/replyto", "$nfile/replyto"); + $filename = copy("$file/filename", "$nfile/filename"); + link "$file/data", "$nfile/data" or die http_die("cannot create $nfile/data - $!"); unless ($dkey = readlink("$nfile/dkey") and -l "$dkeydir/$dkey") { $dkey = randstring(8); unlink "$dkeydir/$dkey"; - symlink "../$nfile","$dkeydir/$dkey" + symlink "../$nfile","$dkeydir/$dkey" or http_die("cannot symlink $dkeydir/$dkey"); unlink "$nfile/dkey"; - symlink $dkey,"$nfile/dkey" + symlink $dkey,"$nfile/dkey" or http_die("cannot create $nfile/dkey - $!"); } - + if ($nomail or $nomail{$to}) { if ($filename) { my $url = "$durl/$dkey/".normalize_filename($filename); @@ -2535,34 +2651,11 @@ sub calcsize { } -# read one line from STDIN (net socket) and assign it to $_ -# returns number of read bytes -sub nvt_read { - my $len = 0; - - if (defined ($_ = )) { - debuglog($_); - $len = length; - $rb += $len; - s/\r?\n//; - } - return $len; -} - - -# read forward to given pattern -sub nvt_skip_to { - my $pattern = shift; - - while (&nvt_read) { return if /$pattern/ } -} - - # set parameter variables sub setparam { my ($v,$vv) = @_; my ($idf,$to); - + $v = uc(despace($v)); # if ($vv =~ /([<>])/) { @@ -2584,31 +2677,39 @@ sub setparam { 'Content-Length: 0', "" ); - &reexec; + } else { + nvt_print( + "HTTP/1.1 302 Found", + "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/fup", + 'Content-Length: 0', + "" + ); } + &reexec; } elsif ($v eq 'LOCALE' and $vv =~ /^(\w+)$/) { $locale = $1; } elsif ($v eq 'REDIRECT' and $vv =~ /^([\w?=]+)$/) { $redirect = $1; - } elsif (($v eq 'KEY' or $v eq 'SKEY') and $vv =~ /^([\w:]+)$/) { + } elsif ($v eq 'SKEY' and $vv =~ /^([\w:]+)/) { $skey = $1; $restricted = $v; - } elsif ($v eq 'GKEY' and $vv =~ /^([\w:]+)$/) { + } elsif ($v eq 'GKEY' and $vv =~ /^([\w:]+)/) { $gkey = $1 unless $nomail; $restricted = $v; - } elsif ($v eq 'DKEY' and $vv =~ /^(\w+)$/) { + } elsif ($v eq 'DKEY' and $vv =~ /^(\w+)/) { $dkey = $1; - } elsif ($v eq 'AKEY' and $vv =~ /^(\w+)$/) { + } elsif ($v eq 'AKEY' and $vv =~ /^(\w+)/) { $akey = $1; - } elsif ($v eq 'FROM' or $v eq 'USER') { + } elsif ($v eq 'FROM' or $v eq 'USER') { $from = normalize_email($vv); $from = untaint(expand($from)); checkchars('from address',$from); - checkaddress($from) or http_die("FROM $from is no legal e-mail address"); - } elsif ($v eq 'REPLYTO') { + # maybe FROM=SUBUSER ! + # checkaddress($from) or http_die("FROM $from is no legal e-mail address"); + } elsif ($v eq 'REPLYTO') { $replyto = normalize_email($vv); checkchars('replyto address',$replyto); - checkaddress($replyto) or + checkaddress($replyto) or http_die("REPLYTO $replyto is no legal e-mail address"); } elsif ($v eq 'ADDTO') { $vv =~ s/\s.*//; @@ -2618,6 +2719,7 @@ sub setparam { } elsif ($v eq 'FEXYOURSELF') { $submit = $vv; @to = ($from); + $specific{'autodelete'} = $autodelete = 'no'; } elsif ($v eq 'TO') { # extract AUTODELETE and KEEP options if ($vv =~ s/[\s,]+AUTODELETE=(\w+)//i) { @@ -2633,9 +2735,15 @@ sub setparam { if ($from) { if ($to eq '.') { $to = $from; + unless ($specific{'autodelete'}) { + $specific{'autodelete'} = $autodelete = 'no'; + } } if ($to eq '//') { $to = $from; + unless ($specific{'autodelete'}) { + $specific{'autodelete'} = $autodelete = 'no'; + } $comment = '//'; } } @@ -2680,7 +2788,7 @@ sub setparam { } elsif ($v eq 'SEEK' and $vv =~ /^(\d+)$/) { $seek = $1; } elsif ($v eq 'FILESIZE' and $vv =~ /^(\d+)$/) { - $filesize = $1; # complete filesize! + $filesize = $1; # complete filesize! &check_space($filesize-$seek); } elsif ($v eq 'AUTODELETE' and $vv =~ /^(\w+)$/) { $specific{'autodelete'} = $autodelete = uc($1); @@ -2689,19 +2797,19 @@ sub setparam { $keep = $keep_max if $keep_max and $keep > $keep_max; $specific{'keep'} = $keep; } elsif ($v eq 'TIMEOUT' and $vv =~ /^(\d+)$/) { - $specific{'timeout'} = $timeout = $1; + $specific{'timeout'} = $timeout = $1; } } sub id_forgotten { my ($id,$to,$subuser,$gm,$skey,$gkey,$url,$fup); - + return if $nomail; - + $fup = $durl; $fup =~ s:/fop:/fup:; - + # full user if (open $from,'<',"$from/\@") { $id = getline($from); @@ -2718,7 +2826,7 @@ sub id_forgotten { ))); exit; } - + # sub user foreach my $skey (glob("$skeydir/*")) { if (-f $skey and open $skey,'<',$skey) { @@ -2741,7 +2849,7 @@ sub id_forgotten { exit; } } - + # group user foreach my $gkey (glob("$gkeydir/*")) { if (-f $gkey and open $gkey,'<',$gkey) { @@ -2795,6 +2903,11 @@ sub mail_forgotten { # lookup akey, skey and gkey (full and sub user and group) sub check_keys { + if (@to and "@to" ne '_') { + http_die("you cannot mix TO and SKEY URL parameters") if $skey; + http_die("you cannot mix TO and GKEY URL parameters") if $gkey; + } + # only one key can be valid $akey = $gkey = '' if $skey; $akey = $skey = '' if $gkey; @@ -2863,7 +2976,7 @@ sub check_keys { # sid is not set with web browser # akey with sid is set with schwuppdiwupp & co $idf = "$akeydir/$akey/@"; - + if (open $idf,'<',$idf and $id = getline($idf)) { close $idf; $from = readlink "$akeydir/$akey" @@ -2886,12 +2999,12 @@ sub check_space { my $req = shift; my ($df,$free,$uprq); local *P; - + if (open $df,"df -k $spooldir|") { while (<$df>) { if (/^.+?\s+\d+\s+\d+\s+(\d+)/ and $req/1024 > $1) { $free = int($1/1024); - $uprq = int($req/M); + $uprq = int($req/$MB); if (not $nomail and open P,"|$sendmail -t") { pq(P,qq( 'From: $admin' @@ -2915,10 +3028,10 @@ sub check_space { # global substitution as a function like in gawk -sub gsub { +sub gsub { local $_ = shift; - my ($p,$r) = @_; - s/$p/$r/g; + my ($p,$r) = @_; + s/$p/$r/g; return $_; } @@ -2926,17 +3039,12 @@ sub gsub { # standard log sub fuplog { my $msg = "@_"; - + $msg =~ s/\n/ /g; $msg =~ s/\s+$//; - - if (open $log,'>>',$log) { - flock $log,LOCK_EX; - seek $log,0,SEEK_END; - printf {$log} "%s [%s_%s] %s (%s) %s\n", - isodate(time),$$,$ENV{REQUESTCOUNT},$from,$fra,$msg; - close $log; - } + $msg = sprintf "%s [%s_%s] %s (%s) %s\n", + isodate(time),$$,$ENV{REQUESTCOUNT},$from,$fra,$msg; + writelog($log,$msg); } @@ -2958,19 +3066,17 @@ sub sigexit { $msg = @_ ? "@_" : '???'; $msg =~ s/\n/ /g; $msg =~ s/\s+$//; - - if (open $log,'>>',$log) { - printf {$log} - "%s %s (%s) %s %s caught SIGNAL %s %s\n", - isodate(time), - $from||'-', - $fra||'-', - $to||'-', - encode_Q($file||'-'), - $msg, - $rb?"(after $rb bytes)":""; - close $log; - } + $msg = sprintf "%s %s (%s) %s %s caught SIGNAL %s %s\n", + isodate(time), + $from||'-', + $fra||'-', + $to||'-', + encode_Q($file||'-'), + $msg, + $RB?"(after $RB bytes)":""; + + writelog($log,$msg); + if ($sig eq 'DIE') { shift; die "$msg\n"; @@ -2980,24 +3086,18 @@ sub sigexit { } -sub mtime { - my @s = lstat shift; - return @s ? $s[9] : undef; -} - - sub present_locales { my $url = shift; my @locales = @::locales; # from fex.ph my ($locale,$lang); - - if ($url =~ /\?/) { + + if ($url =~ /\?/) { $url .= "&"; $url =~ s/locale=\w+&//g; - } else { + } else { $url .= "?"; } - + if (@locales) { map { $_ = "$FEXHOME/locale/$_" } @locales; } else { @@ -3006,8 +3106,7 @@ sub present_locales { if (@locales > 1) { print "

"; - foreach (@locales) { - $locale = $_; + foreach my $locale (my @loop = @locales) { if (-x "$locale/cgi-bin/fup") { $lang = "$locale/lang.html"; $locale =~ s:.*/::; @@ -3027,7 +3126,7 @@ sub present_locales { sub check_camel { my ($logo,$camel); local $/; - + if (open $logo,"$docdir/logo.jpg") { $camel = md5_hex(<$logo>) eq 'ad8a95bba8dd1a61d70bd38611bc2059'; }