BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
+use utf8;
use Encode;
use Fcntl qw':flock :seek :mode';
use IO::Handle;
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";
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);
$id = $rid = $anonymous = 'anonymous';
if ($to =~ /^anonymous/) {
@to = ($to);
- $autodelete{$to} = $autodelete = 'NO';
+ $autodelete{$to} = $autodelete = $specific{'autodelete'}||'NO';
}
$nomail = $anonymous;
}
# 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");
}
}
- 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] <a href=\"%s\">%s</a>%s %s\n",
+ printf "%8s MB
(%2s d) <a href=\"%s\">%s</a>%s %s\n",
$size,
$rkeep,
untaint("/fup?akey=$akey&dkey=$dkey&command=RENOTIFY"),
}
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",
+ printf "%8s MB
(%2s d) %s <a href=\"%s\">%s</a>%s\n",
$size,
$rkeep,
+ stat("$file/download")?'+':'-',
untaint("/fup?akey=$akey&dkey=$dkey&command=FORWARD"),
$filename,
$comment?qq( "$comment"):'';
$akey,$dkey;
printf "[<a href=\"/fup?akey=%s&dkey=%s&command=COPY\">forward</a>] ",
$akey,$dkey;
- printf "%8s MB (%s d) <a href=\"%s\">%s</a>%s\n",
+ printf "%8s MB (%
2s d) <a href=\"%s\">%s</a>%s\n",
$size,$rkeep,$url,$filename,$comment;
}
}
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('');
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";
}
}
{
present_locales('/fup');
+ # print "[$addto] [$submit] [@to]<p>\n";
+
@ab = ("<option></option>");
# select menu from server address book
if (/(\S+)[=\s]+(\S+@[\w.-]+\S*)/) {
$_ = "$1 <$2>";
s/,.*/,.../g;
+ s/:.*/>/;
push @ab,"<option>$_</option>";
}
}
' <input type="hidden" name="from" value="$from">'
' <input type="hidden" name="id" value="$id">'
' <table border="1">'
- ' <tr><td>sender: <td><a href="/fup/$ab64">$from</a></tr>'
+ ' <tr><td>sender: <td><a href="/foc">$from</a></tr>'
' <tr title="e-mail address or alias"><td>recipient(s):'
' <td><input type="text" name="to" size="96" value="$to"><br>'
));
foreach my $rd (@local_rdomains) {
print "*\@$rd\n";
}
+ } elsif (/^\@LOCAL_USERS/) {
+ foreach (glob "*/@") {
+ s:/.::;
+ print "$_\n";
+ }
} else {
print "$_\n";
}
print "Alternate Java client</a> (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;
- }
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!'
+ '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,'
+ '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.'
+ '<p>'
+ 'Use a <a href="/tools.html">F*EX client</a> if you want to send more than one file or resume an interrupted upload.'
'</body></html>'
- ));
+ '<p>'
+ ));
+ print $info_1;
exit;
}
pq(qq(
' <input type="hidden" name="akey" value="$akey">'
' <table border="1">'
- ' <tr><td>sender:<td>$from</tr>'
+ ' <tr><td>sender:<td><a href="/foc">$from</a></tr>'
));
if ($anonymous) {
pq(qq(
pq(qq(
'<form action="/fup"'
' method="post"'
- ' accept-charset="ISO-8859-1"'
+ ' accept-charset="UTF-8"'
' enctype="multipart/form-data">'
' <table>'
' <tr><td>sender:'
# }
print "</form>\n";
- print $info_1;
+ print $info_login||$info_1;
if ($debug and $debug>1) {
print "<hr>\n<pre>\n";
my $to = $_;
$to =~ s/:\w+=.*//; # remove options from address
my $file = "$to/$from/$fkey";
- 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)",
readlink("$file/autodelete")||$autodelete,
readlink("$file/keep")||readlink("$to/\@KEEP")||$keep_default,
- readlink("$to/\@LOCALE")||readlink("$file/locale")||$default_locale,
- readlink("$to/\@NOTIFICATION")||'full';
+ readlink("$to/\@LOCALE")||readlink("$file/locale")||$default_locale;
+ # readlink("$to/\@NOTIFICATION")||'full';
nvt_print("X-Recipient: $to $options");
nvt_print("X-Location: $durl/$dkey{$to}/$fkey") unless $restricted;
}
print "&bwlimit=$bwlimit&autodelete=$autodelete&keep=$keep\">";
print "send another file</a>\n";
if ($http_client !~ /fexsend/ and $http_client =~ /Linux/i) {
- print qq'<p>Hi Linux-user, try <a href="/FAQ/user.html#Why_should_I_use_a_special_F_EX_client">fexsend</a>! ☺<p>\n';
+ print '<p>Hi Linux-user, try ',
+ '<a href="/FAQ/user.html#Why_should_I_use_a_special_F_EX_client">',
+ "fexsend</a>! ☺<p>\n";
+ }
+ if ($http_client !~ /fexit/ and $http_client =~ /Windows/i) {
+ print '<p>Hi Windows-user, try <a href="/fexit.html">fexit</a>! ',
+ "☺<p>\n";
}
print &logout;
}
# parse HTTP QUERY_STRING (parameter=value pairs)
if ($qs) {
foreach (split '&',$qs) {
- if (s/^(\w+)=//) {
- my $x = $1;
+ if (s/^(\w+)=(.*)//) {
+ my $p = uc($1);
+ my $v = $2;
# decode URL-encoding
- s/%([a-f0-9]{2})/chr(hex($1))/gie;
- setparam($x,$_);
+ $v =~ s/%([a-f0-9]{2})/chr(hex($1))/gie;
+ setparam($p,$v);
+ if ($p eq 'AUTODELETE') {
+ $specific{'autodelete'} = $autodelete = $v;
+ }
+ if ($p eq 'KEEP' and /^\d+$/) {
+ $specific{'keep'} = $keep = $v;
+ }
+ # if ($p eq 'LOCALE') {
+ # $specific{'locale'} = $locale = $v;
+ # }
}
}
}
&check_space($cl) if $cl > 0;
- $SIG{ALRM} = sub { die "TIMEOUT\n" };
+ $SIG{ALRM} = sub {
+ $SIG{__DIE__} = 'DEFAULT';
+ die "TIMEOUT\n";
+ };
alarm($timeout);
binmode(STDIN,':raw');
# collect multiple addresses and check for aliases (not group)
if (@to and "@to" !~ /^@[\w-]+$/
- and not ($gkey or $addto or $command =~ /^LIST(RECEIVED)?$/))
- {
-
+ 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);
+ my ($alias,$addresses,$autodelete,$locale,$keep);
while (<$AB>) {
s/#.*//;
$_ = lc $_;
if (s/^\s*(\S+)[=\s]+(\S+)//) {
- ($alias,$address) = ($1,$2);
+ ($alias,$addresses) = ($1,$2);
+ # alias specific options?
$autodelete = $locale = $keep = '';
$autodelete = $1 if /autodelete=(\w+)/;
$locale = $1 if /locale=(\w+)/;
$keep = $1 if /keep=(\d+)/;
- foreach my $address (split(",",$address)) {
- $address .= '@'.$mdomain if $mdomain and $address !~ /@/;
+ foreach my $address (split(",",$addresses)) {
+ # alias address specific :options?
+ if ($address =~ s/(.+?):(.+)/$1/) {
+ my @options = split(':',$2);
+ $address = expand($address);
+ foreach (@options) {
+ if (/^keep=(\d+)$/i) {
+ $alias_keep{$alias}{$address} = $1
+ }
+ if (/^autodelete=(yes|no|delay)$/i) {
+ $alias_autodelete{$alias}{$address} = $1
+ }
+ if (/^locale=(\w+)$/i) {
+ $alias_locale{$alias}{$address} = $1
+ }
+ }
+ } else {
+ $address = expand($address);
+ }
push @{$ab{$alias}},$address;
- $autodelete{$alias} = $autodelete;
- $keep{$alias} = $keep;
- $locale{$alias} = $locale;
+ $autodelete{$alias} = $autodelete if $autodelete;
+ $keep{$alias} = $keep if $keep;
+ $locale{$alias} = $locale if $locale;
}
}
}
# look for recipient's options and eliminate dupes
%to = ();
foreach my $to (my @loop = @to) {
- # address book alias?
- if ($to !~ /@/ and $ab{$to}) {
- foreach my $address (my @loop = @{$ab{$to}}) {
- $address .= '@'.$mdomain if $mdomain and $address !~ /@/;
+ # address book alias?
+ if ($to !~ /@/ and ($ab{$to} or $to =~ /(.+?):(.+)/ and $ab{$1})) {
+ my $alias = $to;
+ my @options = ();
+ $alias =~ s/:(.*)// and @options = split(':',$1);
+ if (@options) {
+ # alias with :options
+ $alias =~ s/:.*//;
+ foreach my $address (my @loop = @{$ab{$alias}}) {
+ $to{$address} = $address; # ignore dupes
+ foreach (@options) {
+ $keep{$address} = $1 if /^keep=(\d+)$/i;
+ $autodelete{$address} = $1 if /^autodelete=(yes|no|delay)$/i;
+ $locale{$address} = $1 if /^locale=(\w+)$/i;
+ }
+ }
+ }
+ foreach my $address (my @loop = @{$ab{$alias}}) {
$to{$address} = $address; # ignore dupes
- if ($specific{'autodelete'}) {
- $autodelete{$address} = $specific{'autodelete'};
- } elsif ($autodelete{$to}) {
- $autodelete{$address} = $autodelete{$to};
- } else {
- $autodelete{$address} = readlink "$address/\@AUTODELETE"
- || $autodelete;
+ unless ($keep{$address}) {
+ $keep{$address} = $keep{$alias} if $keep{$alias};
+ if ($specific{'keep'}) {
+ $keep{$address} = $specific{'keep'}
+ } elsif (my $keep = $alias_keep{$alias}{$address}) {
+ $keep{$address} = $keep;
+ } elsif ($keep{$alias}) {
+ $keep{$address} = $keep{$alias}
+ }
}
- if (my $locale = readlink "$address/\@LOCALE") {
- $locale{$address} = $locale;
- } elsif ($locale{$to}) {
- $locale{$address} = $locale{$to};
- } else {
- $locale{$address} = $locale ;
+ unless ($autodelete{$address}) {
+ if ($specific{'autodelete'}) {
+ $autodelete{$address} = $specific{'autodelete'};
+ } elsif (my $autodelete = $alias_autodelete{$alias}{$address}) {
+ $autodelete{$address} = $keep;
+ } elsif ($autodelete{$alias}) {
+ $autodelete{$address} = $autodelete{$alias};
+ } else {
+ $autodelete{$address} = readlink "$address/\@AUTODELETE"
+ || $autodelete;
+ }
}
unless ($locale{$address}) {
- $locale{$address} = $default_locale || 'english';
+ if (my $locale = readlink "$address/\@LOCALE") {
+ $locale{$address} = $locale;
+ } elsif ($locale{$alias}) {
+ $locale{$address} = $locale{$alias};
+ } elsif ($locale = $alias_locale{$alias}{$address}) {
+ $locale{$address} = $locale;
+ } else {
+ $locale{$address} = $::locale ;
+ }
+ $locale{$address} ||= $default_locale || 'english';
}
- if ($specific{'keep'}) { $keep{$address} = $specific{'keep'} }
- elsif ($keep{$to}) { $keep{$address} = $keep{$to} }
}
} else {
+ # regular address, not an alias
+ if ($to =~ s/(.+?):(.+)/$1/) {
+ my @options = split(':',$2);
+ $to = expand($to);
+ foreach (@options) {
+ $keep{$to} = $1 if /^keep=(\d+)$/i;
+ $autodelete{$to} = $1 if /^autodelete=(yes|no|delay)$/i;
+ $locale{$to} = $1 if /^locale=(\w+)$/i;
+ }
+ }
$to = expand($to);
$to{$to} = $to; # ignore dupes
unless ($autodelete{$to}) {
- $autodelete{$to} = readlink "$to/\@AUTODELETE" || $autodelete;
+ $autodelete{$to} = untaint(readlink("$to/\@AUTODELETE")
+ ||$autodelete);
+ if ($specific{'autodelete'}) {
+ $autodelete{$to} = $specific{'autodelete'};
+ }
+ }
+ unless ($keep{$to}) {
+ $keep{$to} = $keep_default;
+ $keep{$to} = $keep if $keep;
+ $keep{$to} = untaint(readlink "$to/\@KEEP") if -l "$to/\@KEEP";
+ $keep{$to} = $specific{'keep'} if $specific{'keep'};
}
- $autodelete{$to} = $specific{'autodelete'} if $specific{'autodelete'};
- $keep{$to} = $keep_default;
- $keep{$to} = $keep if $keep;
- $keep{$to} = untaint(readlink "$to/\@KEEP") if -l "$to/\@KEEP";
- $keep{$to} = $specific{'keep'} if $specific{'keep'};
- # recipient specific parameters
- $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") {
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;
if ($from eq "@to") {
# special "fex yourself"
- mksymlink("$filed/autodelete",'NO');
+ mksymlink("$filed/autodelete",$specific{'autodelete'}||'NO');
} else {
$autodelete{$to} = $autodelete unless $autodelete{$to};
if ($autodelete{$to} =~ /^(DELAY|NO|\d+)$/i) {
$ar .= '|[^\@]+\@' . $rd;
}
$ar .= ')';
+ } elsif (/^\@LOCAL_USERS/ and -s "$to/@") {
+ $allowed = 1;
+ last;
} else {
# allow wildcard *, but not regexps
$ar = quotemeta $_;
sub forward {
my $file = shift;
my ($nfile,$to,$AB);
- my ($filename);
+ my ($filename,$keep);
my (%to);
http_die("no file data for <code>$file</code>") unless -f "$file/data";
+ $keep = $::keep||$keep_default;
+ if (my $mt = mtime("$file/data")) { $keep += int((time-$mt)/$DS) }
+
if (@to) {
# check recipients restriction
}
}
+ @to = keys %to;
+
http_header('200 OK');
print html_header($head);
- @to = keys %to;
-
foreach my $to (my @loop = @to) {
$to =~ s/:\w+=.*//; # remove options from address
$nfile = $file;
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);
$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') {
$from = normalize_email($vv);
} 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) {
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 = '//';
}
}
$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;
}
}
# 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;
projects / fex.git / blobdiff