# Sebastian Zaiser <szcode@arcor.de> (upload status)
#
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
+
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;
# 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 = '';
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
-
+
# 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;
}
}
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;
$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
# 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");
}
}
# 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 = 'NO';
}
$nomail = $anonymous;
}
# 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 \"<code>$okey</code>\" - ".
"request another one from <code>$to</code>");
$from = untaint($from);
}
}
+# 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"||'');
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");
""
);
&reexec;
- } else {
+ } else {
my $s = $!;
http_header('404 Not Found');
print html_header($head);
# 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');
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:/.*::;
$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") {
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",
$size,
untaint("/fup?akey=$akey&dkey=$dkey&command=RENOTIFY"),
$filename,
$comment ? qq' "$comment"' : '',
- $file eq $nfile ?
+ $file eq $nfile ?
" → notification e-mail has been resent" :
"";
}
'</body></html>'
));
exit;
- }
+ }
if ($command =~ /^LIST(RECEIVED)?$/) {
http_die("illegal command \"$command\"") if $public or $anonymous;
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";
$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);
+ my $rkeep = untaint(readlink "$file/keep"||$keep_default)
+ - int((time-mtime("$file/filename"))/$DS);
printf "%8s MB [%s d] <a href=\"%s\">%s</a>%s\n",
$size,
$rkeep,
'<p><a href="javascript:history.back()">back to F*EX operation control</a>'
'</body></html>'
));
- }
+ }
# list received files
else {
$to = $from;
$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:.*/(.+):;
$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 = ' "'.$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 "[<a href=\"/fup?akey=%s&dkey=%s&command=DELETE\">delete</a>] ",
$akey,$dkey;
printf "[<a href=\"/fup?akey=%s&dkey=%s&command=COPY\">forward</a>] ",
));
}
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 "<h2>Download URLs of files you have sent\n";
));
exit;
}
-
+
if ($command eq 'FOPLOG') {
http_die("illegal command \"$command\"") if $public or $anonymous;
if (open my $log,"$logdir/fop.log") {
}
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_]+\]//;
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;
}
http_die("illegal parameter <code>$del</code>");
}
$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";
http_header('200 OK',"X-File: $del");
print html_header($head);
print "<h3>$file deleted</h3>\n";
- } else {
+ } else {
http_header("404 Not Found");
print html_header($head);
print "<h3>$file not deleted</h3>\n";
}
}
-# 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");
}
}
# (= 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>) {
}
$to = join(',',@to);
-
+
if ($to =~ /^@(.+)/) {
if ($nomail) {
http_die("server runs in NOMAIL mode - groups ($to) are not allowed");
# 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}) {
push @cookies,"Set-Cookie: $1=; Max-Age=0; Discard";
}
}
-
- # 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;
}
http_header('200 OK',@cookies);
# print html_header($head,'<img src="/fex_small.gif">');
print html_header($head);
-
+
if ($http_client =~ /(Konqueror|w3m)/) {
pq(qq(
'<p><hr><p>'
}
# 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';
}
and not ($gkey or $skey or $okey or $public or $anonymous))
{
present_locales('/fup');
-
+
@ab = ("<option></option>");
-
+
# 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>";
push @ab,"<option>$_</option>";
}
}
- close $ab;
+ close $AB;
}
-
+
unless (@to) {
unless ($nomail) {
foreach (glob "$from/\@GROUP/*") {
}
}
}
-
+
my $ab64 = b64("from=$from&id=$id");
# '<form class="uploadform" name="upload"'
pq(qq(
print "</pre><p>\n";
close $rr;
}
- pq(qq(
- ' <input type="submit" name="submit" value="check recipient(s) and continue">'
- ' or <input type="submit" name="fexyourself" value="fex yourself">'
- '</form>'
- '<p>'
- ));
+ print qq' <input type="submit" name="submit" value="check recipient(s) and continue">';
+ if ($fex_yourself =~ /^yes|1/i) {
+ print qq' or <input type="submit" name="fexyourself" value="fex yourself">'
+ }
+ print "\n</form>\n<p>\n";
if ($akey and -f "$from/\@" and not $captive ) {
pq(qq(
'<a href="/foc?akey=$akey">user config & operation control</a>'
));
}
-
+
if ($from eq $admin ) {
pq(qq(
'<p>'
'<a href="/fac">server config & admin control</a>'
));
}
-
+
if (0 and -f "$docdir/FIX.jar") {
print "<p>\n";
if ($public) { print "<a href=\"/fix?from=$from&id=$public&to=$to\">" }
if (-x "$FEXHOME/cgi-bin/login") {
print $info_login||$info_1;
}
- print "</body></html>\n";
+ pq(qq(
+ '<p><hr><p>'
+ '<b>'
+ 'Warning: the recipient must not be a mailing list, because after'
+ 'download the file will be no more available!'
+ '</b><br>'
+ 'Contact <a href="mailto:$ENV{SERVER_ADMIN}">fexmaster</a>'
+ 'if you want to fex to a mailing list,'
+ 'he can allow multiple downloads for specific addresses.'
+ '</body></html>'
+ ));
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(
'<script type="text/javascript">'
' function showstatus() {'
- ' var file = document.forms["upload"].elements["file"].value;'
- ' if (file != "") {'
- ' window.open('
- " '$ENV{PROTO}://$ENV{HTTP_HOST}/$cgi?showstatus=$uid',"
- " 'fup_status',"
- " 'width=700,height=500'"
- ' );'
- ' return true;'
- ' }'
- ' return false;'
+ ' var file = document.forms["upload"].elements["file"].value;'
+ ' if (file == "") return false;'
+ ' window.open('
+ " '/$cgi?showstatus=$uid',"
+ " 'fup_status',"
+ " 'width=700,height=500'"
+ ' );'
+ ' return true;'
' }'
''
' function checkupload() {'
' <input type="hidden" name="from" value="$from">'
' <input type="hidden" name="filesize" value="">'
));
-
+
if ($public) {
my $toh = join('<br>',@to);
pq(qq(
));
}
}
-
+
$autodelete = lc $autodelete;
$keep = $keep_default unless $keep;
my ($quota,$du) = check_sender_quota($muser||$from);
- $quota = $quota
- ? "<tr><td>sender quota (used):<td>$quota ($du) MB</tr>"
+ $quota = $quota
+ ? "<tr><td>sender quota (used):<td>$quota ($du) MB</tr>"
: '';
-
- $bwl = qq'<td><input type="text" name="bwlimit" size="8" value="$bwlimit"> kB/s';
+
+ $bwl = qq'<input type="text" name="bwlimit" size="8" value="$bwlimit"> kB/s';
if (@throttle) {
foreach (@throttle) {
if (/\[?(.+?)\]?:(\d+)$/) {
# throttle ip address?
if ($throttle =~ /^[\w:.-]+$/) {
if (ipin($ra,$throttle)) {
- $bwl = qq'<td><input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
+ $bwl = qq'<input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
last;
}
- }
+ }
# throttle e-mail address?
else {
# allow wildcard *, but not regexps
$throttle =~ quotemeta $throttle;
$throttle =~ s/\*/.*/g;
if ($from =~ /^$throttle$/i) {
- $bwl = qq'<td><input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
+ $bwl = qq'<input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
last;
}
}
}
}
}
-
+
$autodelete = $autodelete{$to} if $autodelete{$to};
-
+
my $adt = '';
for ($autodelete) {
- if (/yes/i) { $adt = 'delete file after download' }
+ if (/yes/i) { $adt = 'delete file after download' }
elsif (/no/i) { $adt = 'do not delete file after download' }
- elsif (/delay/i) { $adt = 'delete file after download with delay' }
+ elsif (/delay/i) { $adt = 'delete file after download with delay' }
elsif (/^\d+$/) { $adt = "delete file $autodelete days after download" }
}
+ $adt .= qq'<input type="hidden" name="autodelete" value="$autodelete">';
my $ctr = my $ktr = '';
if ($nomail) {
- $ctr = qq'<td><input type="hidden" name="comment" value="$comment">'
- .qq'<em>no notification e-mail will be send</em>';
- $ktr = qq'<input type="text" name="keep" size="2" value="$keep"> days</tr>';
- $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep"></tr>';
+ $ctr = qq'<em>no notification e-mail will be send</em>';
} else {
- $ctr = qq'<td><input type="text" name="comment" size="80" value="$comment">';
- $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep"></tr>';
+ $ctr = qq'<input type="text" name="comment" size="80" value="$comment">';
}
if ($captive) {
- $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep"></tr>';
+ $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep">';
+ } else {
+ $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep">';
}
-
pq(qq(
- ' <tr title="$adt"><td>autodelete:<td>$adt</tr>'
- ' <input type="hidden" name="autodelete" value="$autodelete">'
- ' <tr title="keep file max $keep days, then delete it"><td>keep:<td>'
- ' $ktr'
+ ' <tr><td>autodelete:'
+ ' <td>$adt'
+ ' </tr>'
+ ' <tr title="keep file max $keep days, then delete it"><td>keep:'
+ ' <td>$ktr'
+ ' </tr>'
' $quota'
' <tr title="optional, full speed if empty"><td>bandwith limit:'
- ' $bwl'
+ ' <td>$bwl'
' </tr>'
' <tr title="optional, will be included in notification e-mail"><td>comment:'
- ' $ctr'
+ ' <td>$ctr'
' </tr>'
- ' <tr title="If you want to send more than one file, then put them in a zip or tar archive">'
- ' <td>file:'
- ' <td><input type="file" name="file" size="80" value="$file" onchange="reportsize();">'
+ ' <tr title="If you want to send more than one file, then put them in a zip or tar archive"><td>file:'
+ ' <td><input type="file" name="file" size="80" value="$file" onchange="reportsize();">'
' </tr>'
' <tr><td>file size:<td id="filesize"></td></tr>'
' </table>'
' <p><input type="submit" value="check ID and continue"><p>'
));
if (not $nomail and (
- @local_domains and @local_hosts and ipin($ra,@local_hosts)
- or @local_rdomains and @local_rhosts and
- (not @registration_hosts or ipin($ra,@registration_hosts))
- or @demo
+ @local_domains and @local_hosts or
+ @local_rdomains and @local_rhosts or
+ @demo
)) {
pq(qq(
'You can <a href="/fur">register yourself</a> '
# ));
# }
print "</form>\n";
-
+
print $info_1;
if ($debug and $debug>1) {
}
print "</pre>\n";
}
-
+
print "</body></html>\n";
exit;
}
check_rr($from,$from);
@to = ($from);
$sup = 'fexyourself';
+ $keep{$from} = readlink("$from/\@KEEP")||$keep_default;
}
# all these variables should be defined here, but just to be sure...
}
# additional last check
-foreach $to (@to) {
- checkaddress($to) or
- http_die("<code>$to</code> is not a valid e-mail address");
+unless (@group or $gkey or $skey or $public or $okey) {
+ foreach $to (@to) {
+ checkaddress($to) or
+ http_die("<code>$to</code> is not a valid e-mail address");
+ }
}
+
$to = join(',',@to);
-# file overwriting for anonymous is only possible if his client has the
+# file overwriting for anonymous is only possible if his client has the
# download cookie - else request purging
if ($anonymous and not $seek and my $dkey = readlink "$to/$from/$fkey/dkey") {
if ($overwrite =~ /^n/i) {
$overwrite{$to}++ if -f $save and not -f $download;
unlink $save,$download;
rename $upload,$save or http_die("cannot rename $upload to $save - $!\n");
-
+
# log dkey
- my $dlog = "$logdir/dkey.log";
- if (open $dlog,'>>',$dlog) {
- flock $dlog,LOCK_EX;
- seek $dlog,0,SEEK_END;
- printf {$dlog} "%s %s %s %s %s\n",
- isodate(time),$dkey{$to},$from,$to,$fkey;
- close $dlog;
- }
-
+ my $msg = sprintf "%s %s %s %s %s\n",
+ isodate(time),$dkey{$to},$from,$to,$fkey;
+ writelog('dkey.log',$msg);
+
# send notification e-mails if necessary
if (not $nomail and (readlink "$to/\@NOTIFICATION"||'') !~ /^no/i
and ($comment or not $overwrite{$to})) {
print html_header($head);
if ($nostore) {
- printf "%s (%s MB) received\n",$file,$ndata/M;
+ printf "%s (%s MB) received\n",$file,int($ndata/$MB);
} elsif (not $restricted and ($anonymous or $from eq $to)) {
my $size = $ndata<2*1024 ? sprintf "%s B",$ndata:
- $ndata<2*M ? sprintf "%s kB",int($ndata/1024):
- sprintf "%s MB",int($ndata/M);
+ $ndata<2*$MB ? sprintf "%s kB",int($ndata/1024):
+ sprintf "%s MB",int($ndata/$MB);
pq(qq(
'<code>$file</code> ($size) received and saved<p>'
'Download URL for copy & paste:'
if (not $boring and not $seek) {
print "Ehh... $ndata <b>BYTES</b>?! You are kidding?<p>\n";
}
- } elsif ($ndata<2*M) {
+ } elsif ($ndata<2*$MB) {
$ndata = int($ndata/1024);
print "<code>$file</code> ($ndata kB) received and saved<p>\n";
if ($ndata<1024 and not ($boring or $seek)) {
"ever heard of MIME e-mail? ☺<p>\n";
}
} else {
- $ndata = int($ndata/M);
+ $ndata = int($ndata/$MB);
print "<code>$file</code> ($ndata MB) received and saved<p>\n";
}
print "<ul>\n";
print "Link is valid for $keep{$to} days!<p>\n";
}
}
- } elsif ($overwrite{$to} and not $comment) {
- print "(old <code>$file</code> for $to overwritten)<p>\n"
- } else {
+ } elsif ($overwrite{$to} and not $comment) {
+ print "(old <code>$file</code> for $to overwritten)<p>\n"
+ } else {
print "$to notified<p>\n"
}
}
setparam($k,$v);
}
}
-
+
# decode base64 PATH_INFO to QUERY_STRING
if ($ENV{PATH_INFO} =~ m:^/(\w+=*)$:) {
if ($qs) {
my $x = $1;
# decode URL-encoding
s/%([a-f0-9]{2})/chr(hex($1))/gie;
- setparam($x,$_);
+ setparam($x,$_);
}
}
}
);
&reexec;
}
-
+
if ($showstatus) {
&showstatus;
exit;
}
-
+
# check for akey, gkey and skey (from HTTP GET)
&check_keys;
-
+
if ($ENV{REQUEST_METHOD} eq 'POST' and $cl) {
foreach $sig (keys %SIG) {
if ($sig !~ /^(CHLD|CLD)$/) {
$cl,$ENV{REMOTE_ADDR}||'',$ENV{REMOTE_HOST}||''),"\n");
&check_space($cl) if $cl > 0;
-
+
$SIG{ALRM} = sub { die "TIMEOUT\n" };
alarm($timeout);
binmode(STDIN,':raw');
-
+
if (defined($ENV{FEX_FILENAME})) {
# JUP via HTTP header
$file = $param{'FILE'} = $ENV{FEX_FILENAME};
} else {
http_die("malformed HTTP POST (no boundary found)");
}
-
+
READPOST: while (&nvt_read) {
# the file itself - *must* be last part of POST!
if (/^Content-Disposition:\s*form-data;\s*name="file";\s*filename="(.+)"/i) {
push @header,$_;
}
# STDIN is now at begin of file, will be read later with get_file()
- last;
+ last;
}
# all other parameters
if (/^Content-Disposition:\s*form-data;\s*name="([a-z]\w*)"/i) {
}
}
}
-
+
if (length($file)) {
$file =~ s/%(\d+)/chr($1)/ge;
$file = untaint(strip_path(normalize($file)));
}
if ($from) {
- $from .= '@'.$mdomain if $mdomain and $from !~ /@/;
- if ($from ne 'anonymous' and not checkaddress($from)) {
- http_die("<code>$from</code> is not a valid e-mail address");
+ unless ($skey or $gkey or $okey) {
+ $from .= '@'.$mdomain if $mdomain and $from !~ /@/;
+ if ($from ne 'anonymous' and not checkaddress($from)) {
+ http_die("<code>$from</code> is not a valid e-mail address");
+ }
}
$from = untaint($from);
}
# collect multiple addresses and check for aliases (not group)
- if (@to and "@to" !~ /^@[\w-]+$/
- and not ($gkey or $addto or $command =~ /^LIST(RECEIVED)?$/))
+ if (@to and "@to" !~ /^@[\w-]+$/
+ and not ($gkey or $addto or $command =~ /^LIST(RECEIVED)?$/))
{
-
+
# read address book
if ($from and open my $AB,'<',"$from/\@ADDRESS_BOOK") {
my ($alias,$address,$autodelete,$locale,$keep);
# look for recipient's options and eliminate dupes
%to = ();
- foreach (@to) {
- my $to = $_;
+ foreach my $to (my @loop = @to) {
# address book alias?
- if ($ab{$to}) {
- foreach (@{$ab{$to}}) {
- my $address = $_;
+ if ($to !~ /@/ and $ab{$to}) {
+ foreach my $address (my @loop = @{$ab{$to}}) {
$address .= '@'.$mdomain if $mdomain and $address !~ /@/;
$to{$address} = $address; # ignore dupes
if ($specific{'autodelete'}) {
} elsif ($autodelete{$to}) {
$autodelete{$address} = $autodelete{$to};
} else {
- $autodelete{$address} = readlink "$address/\@AUTODELETE"
+ $autodelete{$address} = readlink "$address/\@AUTODELETE"
|| $autodelete;
}
- if ($_ = readlink "$address/\@LOCALE") {
- $locale{$address} = $_;
+ if (my $locale = readlink "$address/\@LOCALE") {
+ $locale{$address} = $locale;
} elsif ($locale{$to}) {
$locale{$address} = $locale{$to};
} else {
$keep{$to} = $1 if $to =~ /:keep=(\d+)/i;
$autodelete{$to} = $1 if $to =~ /:autodelete=(\w+)/i;
}
+ $autodelete{$to} = 'NO' if $to =~ /$amdl/; # mailing lists, etc
if (-e "$to/\@CAPTIVE") {
my $v;
$v = readlink "$to/\@AUTODELETE" and $autodelete{$to} = $v;
}
}
@to = keys %to;
-
+
if (scalar(@to) == 1) {
- $to = "@to";
+ $to = "@to";
$keep = $keep{$to} if $keep{$to};
$autodelete = $autodelete{$to} if $autodelete{$to};
}
-
+
# check recipients and eliminate dupes
%to = ();
foreach $to (@to) {
http_die("You cannot send to more than one group") if @to > 1;
http_die("Group <code>$to</code> does not exist") unless -f "$from/\@GROUP/$1";
} else {
- $to .= '@'.$mdomain if $mdomain and $to !~ /@/;
- if (checkaddress($to)) {
+ if ($skey or $gkey or $okey or checkaddress($to)) {
+ $to .= '@'.$mdomain if $mdomain and $to !~ /@/;
$to{$to} = untaint($to);
} else {
http_die("<code>$to</code> is not a valid e-mail address");
my ($t0,$t1,$t2,$tt,$ts,$tm);
my ($osize,$percent,$npercent);
local $_;
-
+
$wclose = '<p><a href="#" onclick="window.close()">close</a>'."\n".
'</body></html>'."\n";
$ukey = "$ukeydir/$uid";
sleep 1;
$tsize = readlink $sfile and last;
# upload error?
- # remark: stupid Internet Explorer *needs* the error represented in this
+ # remark: stupid Internet Explorer *needs* the error represented in this
# asynchronous popup window, because it cannot display the error in the
# main window on HTTP POST!
- if (-f $ukey and open $ukey,'<',$ukey or
+ if (-f $ukey and open $ukey,'<',$ukey or
-f "$ukey/error" and open $ukey,'<',"$ukey/error") {
undef $/;
unlink $ukey;
}
}
# unlink $sfile;
-
+
if (defined $tsize and $tsize == 0) {
print "<script type='text/javascript'>window.close()</script>\n";
exit;
"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 $/;
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(
"<html><body>"
"<center>"
"<div style='float:left;width:0%;background:black;height:20px;' id='bar'>"
"</div></div>"
));
-
+
# wait for upload file
for (1..9) {
last if -f $upload or -f $data;
print $wclose;
exit;
}
-
+
$SIG{ALRM} = sub { 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;
# 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);
)) or last;
}
}
-
+
alarm(0);
if ($npercent == 100) {
print "<h3>file successfully transferred</h3>\n";
http_die("<code>$filed</code> 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;
symlink "../$filed","$ukeydir/$uid";
}
}
-
+
unlink "$filed/autodelete",
"$filed/error",
"$filed/restrictions",
"$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";
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",'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) {
}
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;
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);
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;
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
# 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;
}
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!".
" 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>||'';
}
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");
my @to = @_;
my $rr = "$from/\@ALLOWED_RECIPIENTS";
my ($allowed,$to,$ar,$rd);
-
+
if (-s $rr and open $rr,'<',$rr) {
$restricted = $rr;
chomp;
s/#.*//;
s/\s//g;
-
+
if (/^\@LOCAL_RDOMAINS/) {
$ar = '(@';
foreach (@local_rdomains) {
$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;
}
}
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);
}
}
# collect addresses
- foreach (@to) {
- my $to = $_;
+ foreach my $to (my @loop = @to) {
if ($ab{$to}) {
foreach my $address (@{$ab{$to}}) {
$to{$address} = $address;
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/:;
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);
}
-# read one line from STDIN (net socket) and assign it to $_
-# returns number of read bytes
-sub nvt_read {
- my $len = 0;
-
- if (defined ($_ = <STDIN>)) {
- 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 =~ /([<>])/) {
'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 'KEY' or $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.*//;
} 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);
$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);
)));
exit;
}
-
+
# sub user
foreach my $skey (glob("$skeydir/*")) {
if (-f $skey and open $skey,'<',$skey) {
exit;
}
}
-
+
# group user
foreach my $gkey (glob("$gkeydir/*")) {
if (-f $gkey and open $gkey,'<',$gkey) {
# 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"
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'
# 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 $_;
}
# 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);
}
$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";
}
-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 {
if (@locales > 1) {
print "<h3>";
- foreach (@locales) {
- $locale = $_;
+ foreach my $locale (my @loop = @locales) {
if (-x "$locale/cgi-bin/fup") {
$lang = "$locale/lang.html";
$locale =~ s:.*/::;
sub check_camel {
my ($logo,$camel);
local $/;
-
+
if (open $logo,"$docdir/logo.jpg") {
$camel = md5_hex(<$logo>) eq 'ad8a95bba8dd1a61d70bd38611bc2059';
}
projects / fex.git / blobdiff