# set and untaint ENV if not in CLI (fexsrv provides clean ENV)
unless (-t) {
foreach my $v (keys %ENV) {
- ($ENV{$v}) = ($ENV{$v} =~ /(.*)/s);
+ ($ENV{$v}) = ($ENV{$v} =~ /(.*)/s) if defined $ENV{$v};
}
$ENV{PATH} = '/usr/local/bin:/bin:/usr/bin';
$ENV{IFS} = " \t\n";
$autodelete = 'YES';
$overwrite = 'YES';
$limited_download = 'YES'; # multiple downloads only from same client
+$fex_yourself = 'YES'; # allow SENDER = RECIPIENT
$keep = 5; # days
$recipient_quota = 0; # MB
$sender_quota = 0; # MB
$timeout = 30; # seconds
$bs = 2**16; # I/O blocksize
+$DS = 60*60*24; # seconds in a day
+$MB = 1024*1024; # binary Mega
$use_cookies = 1;
$sendmail = '/usr/lib/sendmail';
$sendmail = '/usr/sbin/sendmail' unless -x $sendmail;
$mail_authid = 0 if $mail_authid =~ /no/i;
$force_https = 0 if $force_https =~ /no/i;
$debug = 0 if $debug =~ /no/i;
-
+
+@logdir = ($logdir) unless @logdir;
+$logdir = $logdir[0];
+
# check for name based virtual host
$vhost = vhost($ENV{'HTTP_HOST'});
+$RB = 0; # read POST bytes
+
push @doc_dirs,$docdir;
foreach my $ld (glob "$FEXHOME/locale/*/htdocs") {
push @doc_dirs,$ld;
$nomail = ($mailmode =~ /^MANUAL|nomail$/i);
if (not $nomail and not -x $sendmail) {
- http_die("found no sendmail\n");
+ http_die("found no sendmail");
}
http_die("cannot determine the server hostname") unless $hostname;
$default_locale ||= 'english';
+# $durl is first default fop download URL
+# @durl is optional mandatory fop download URL list (from fex.ph)
unless ($durl) {
- my $host = '';
- my $port = 0;
-
- ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
- $host = $hostname;
-
- unless ($port) {
- $port = 80;
- if (open my $xinetd,'<',"/etc/xinetd.d/fex") {
- while (<$xinetd>) {
- if (/^\s*port\s*=\s*(\d+)/) {
- $port = $1;
- last;
+ if (@durl) {
+ $durl = $durl[0];
+ } elsif ($ENV{HTTP_HOST} and $ENV{PROTO}) {
+ my $host = '';
+ my $port = 0;
+
+ ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
+ $host = $hostname;
+
+ unless ($port) {
+ $port = 80;
+ if (open my $xinetd,'<',"/etc/xinetd.d/fex") {
+ while (<$xinetd>) {
+ if (/^\s*port\s*=\s*(\d+)/) {
+ $port = $1;
+ last;
+ }
}
+ close $xinetd;
}
- close $xinetd;
}
- }
- # use same protocal as uploader for download
- if ($ENV{PROTO} eq 'https' and $port == 443 or $port == 80) {
- $durl = "$ENV{PROTO}://$host/fop";
+ # use same protocal as uploader for download
+ if ($ENV{PROTO} eq 'https' and $port == 443 or $port == 80) {
+ $durl = "$ENV{PROTO}://$host/fop";
+ } else {
+ $durl = "$ENV{PROTO}://$host:$port/fop";
+ }
} else {
- $durl = "$ENV{PROTO}://$host:$port/fop";
+ $durl = "http://$hostname/fop";
}
}
-@durl = ($durl) unless @durl;
-
sub reexec {
exec($FEXHOME.'/bin/fexsrv') if $ENV{KEEP_ALIVE};
sub http_die {
# not in CGI mode
- die "$0: @_\n" unless $ENV{GATEWAY_INTERFACE};
+ unless ($ENV{GATEWAY_INTERFACE}) {
+ warn "$0: @_\n"; # must not die, because of fex_cleanup!
+ return;
+ }
debuglog(@_);
}
+sub normalize_user {
+ my $user = shift;
+
+ $user = lc(urldecode(despace($user)));
+ $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
+ checkaddress($user) or http_die("$user is not a valid e-mail address");
+ return untaint($user);
+}
+
+
+sub urldecode {
+ local $_ = shift;
+ s/%([a-f0-9]{2})/chr(hex($1))/gie;
+ return $_;
+}
+
+
sub untaint {
local $_ = shift;
/(.*)/s;
$a =~ s/:\w+=.*//; # remove options from address
return $a if $a eq 'anonymous';
-
- $re = '^[.@]|@.*@|local(host|domain)$|["\'\`\|\s()<>/;,]';
+
+ $a .= '@'.$mdomain if $mdomain and $a !~ /@/;
+
+ $re = '^[.@-]|@.*@|local(host|domain)$|["\'\`\|\s()<>/;,]';
if ($a =~ /$re/i) {
debuglog("$a has illegal syntax ($re)");
return '';
return if -d $dir;
$dir =~ s:/+$::;
- http_die("cannot mkdir /\n") unless $dir;
+ http_die("cannot mkdir /") unless $dir;
$pdir = $dir;
if ($pdir =~ s:/[^/]+$::) {
mkdirp($pdir) unless -d $pdir;
}
unless (-d $dir) {
- mkdir $dir,0770 or http_die("mkdir $dir - $!\n");
+ mkdir $dir,0770 or http_die("mkdir $dir - $!");
}
}
# file and document log
sub fdlog {
my ($log,$file,$s,$size) = @_;
- my $ra;
-
- if (open $log,'>>',$log) {
- flock $log,LOCK_EX;
- seek $log,0,SEEK_END;
- $ra = $ENV{REMOTE_ADDR}||'-';
- $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
- $ra =~ s/\s//g;
- $file =~ s:/data$::;
- printf {$log}
- "%s [%s_%s] %s %s %s/%s\n",
- isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file),$s,$size;
- close $log;
- }
+ my $ra = $ENV{REMOTE_ADDR}||'-';
+ my $msg;
+
+ $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
+ $ra =~ s/\s//g;
+ $file =~ s:/data$::;
+ $msg = sprintf "%s [%s_%s] %s %s %s/%s\n",
+ isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file),$s,$size;
+
+ writelog($log,$msg);
}
return unless $debug and @_;
unless ($debuglog and fileno $debuglog) {
- mkdir "$logdir/.debug",0770 unless -d "$logdir/.debug";
+ my $ddir = "$spooldir/.debug";
+ mkdir $ddir,0770 unless -d $ddir;
$prg =~ s:.*/::;
$prg = untaint($prg);
- $debuglog = sprintf("%s/.debug/%s_%s_%s.%s",
- $logdir,time,$$,$ENV{REQUESTCOUNT}||0,$prg);
+ $debuglog = sprintf("%s/%s_%s_%s.%s",
+ $ddir,time,$$,$ENV{REQUESTCOUNT}||0,$prg);
$debuglog =~ s/\s/_/g;
# open $debuglog,'>>:encoding(UTF-8)',$debuglog or return;
open $debuglog,'>>',$debuglog or return;
# extra debug log
sub errorlog {
my $prg = $0;
- my $log = "$logdir/error.log";
my $msg = "@_";
+ my $ra = $ENV{REMOTE_ADDR}||'-';
+ $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
+ $ra =~ s/\s//g;
$prg =~ s:.*/::;
$msg =~ s/[\r\n]+$//;
$msg =~ s/[\r\n]+/ /;
$msg =~ s/\s*<p>.*//;
+ $msg = sprintf "%s %s %s %s\n",isodate(time),$prg,$ra,$msg;
- if (open $log,'>>',$log) {
- flock $log,LOCK_EX;
- seek $log,0,SEEK_END;
- $ra = $ENV{REMOTE_ADDR}||'-';
- $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
- $ra =~ s/\s//g;
- printf {$log} "%s %s %s %s\n",isodate(time),$prg,$ra,$msg;
- close $log;
+ writelog('error.log',$msg);
+}
+
+
+sub writelog {
+ my $log = shift;
+ my $msg = shift;
+
+ foreach my $logdir (@logdir) {
+ if (open $log,'>>',"$logdir/$log") {
+ flock $log,LOCK_EX;
+ seek $log,0,SEEK_END;
+ print {$log} $msg;
+ close $log;
+ }
}
}
my $sender = shift;
my $squota = $sender_quota||0;
my $du = 0;
- my ($file,$size,%file,$data);
+ my ($file,$size,%file,$data,$upload);
local $_;
if (open $qf,'<',"$sender/\@QUOTA") {
foreach $file (glob "*/$sender/*") {
$data = "$file/data";
+ $upload = "$file/upload";
if (not -l $data and $size = -s $data) {
# count hard links only once (= same inode)
my $i = (stat($data))[1]||0;
$du += $size;
$file{$i} = $i;
}
- } elsif (-f "$file/upload" and $size = readlink "$file/size") {
- $du += $size;
+ } elsif (-f $upload) {
+ # count hard links only once (= same inode)
+ my $i = (stat($upload))[1]||0;
+ unless ($file{$i}) {
+ $size = readlink "$file/size" and $du += $size;
+ $file{$i} = $i;
+ }
}
}
}
+# read one line from STDIN (net socket) and assign it to $_
+# return number of read bytes
+# also set global variable $RB (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/ }
+}
+
+
+# HTTP GET and POST parameters
+# (not used by fup)
+# fills global variable %PARAM :
+# normal parameter is $PARAM{$parameter}
+# file parameter is $PARAM{$parameter}{filename} $PARAM{$parameter}{data}
+sub parse_parameters {
+ my $cl = $ENV{X_CONTENT_LENGTH} || $ENV{CONTENT_LENGTH} || 0;
+ my $data = '';
+ my $filename;
+ local $_;
+
+ if ($cl > 128*$MB) {
+ http_die("request too large");
+ }
+
+ foreach (split('&',$ENV{QUERY_STRING})) {
+ if (/(.+?)=(.*)/) { $PARAM{$1} = $2 }
+ else { $PARAM{$_} = $_ }
+ }
+ $_ = $ENV{CONTENT_TYPE}||'';
+ if ($ENV{REQUEST_METHOD} eq 'POST' and /boundary=\"?([\w\-\+\/_]+)/) {
+ my $boundary = $1;
+ while ($RB<$cl and &nvt_read) { last if /^--\Q$boundary/ }
+ # continuation lines are not checked!
+ while ($RB<$cl and &nvt_read) {
+ $filename = '';
+ if (/^Content-Disposition:.*\s*filename="(.+?)"/i) {
+ $filename = $1;
+ }
+ if (/^Content-Disposition:\s*form-data;\s*name="(.+?)"/i) {
+ my $p = $1;
+ # skip rest of mime part header
+ while ($RB<$cl and &nvt_read) { last if /^\s*$/ }
+ $data = '';
+ while (<STDIN>) {
+ if ($p =~ /password/i) {
+ debuglog('*' x length)
+ } else {
+ debuglog($_)
+ }
+ $RB += length;
+ last if /^--\Q$boundary/;
+ $data .= $_;
+ }
+ unless (defined $_) { die "premature end of HTTP POST\n" }
+ $data =~ s/\r?\n$//;
+ if ($filename) {
+ $PARAM{$p}{filename} = $filename;
+ $PARAM{$p}{data} = $data;
+ } else {
+ $PARAM{$p} = $data;
+ }
+ last if /^--\Q$boundary--/;
+ }
+ }
+ }
+}
+
+
# name based virtual host?
sub vhost {
my $hh = shift; # HTTP_HOST
$ENV{FEXLIB} = $FEXLIB = "$vhost/lib";
$logdir = $spooldir = "$vhost/spool";
$docdir = "$vhost/htdocs";
+ @logdir = ($logdir);
if ($locale and -e "$vhost/locale/$locale/lib/fex.ph") {
$ENV{FEXLIB} = $FEXLIB = "$vhost/locale/$locale/lib";
}
}
+sub mtime {
+ my @s = stat(shift) or return;
+ return $s[9];
+}
+
+
# extract locale functions into hash of subroutine references
# e.g. \&german ==> $notify{german}
sub locale_functions {
status => $status,
dkey => $dkey,
filename => $filename,
- keep => $keep-int((time-$mtime)/DS),
+ keep => $keep-int((time-$mtime)/$DS),
comment => $comment,
autodelete => $autodelete,
replyto => $replyto,
# my ($status,$dkey,$filename,$keep,$warn,$comment,$autodelete) = @_;
my %P = @_;
my ($to,$from,$file,$mimefilename,$receiver,$warn,$comment,$autodelete);
- my ($size,$bytes,$days,$header,$data,$replyto);
+ my ($size,$bytes,$days,$header,$data,$replyto,$uurl);
my ($mfrom,$mto,$dfrom,$dto);
+ my $proto = 'http';
+ my $durl = $::durl;
my $index;
my $fileid = 0;
my $fua = $ENV{HTTP_USER_AGENT}||'';
$comment = encode_utf8($P{comment}||'');
$comment =~ s/^!\*!//; # multi download allow flag
$autodelete = $P{autodelete}||$::autodelete;
- $index = $durl;
- $index =~ s/fop/index.html/;
-
- (undef,$to,$from,$file) = split('/',untaint(readlink("$dkeydir/$P{dkey}")));
+
+ $file = untaint(readlink("$dkeydir/$P{dkey}"));
+ $file =~ s/^\.\.\///;
+ # make download protocal same as upload protocol
+ if ($uurl = readlink("$file/uurl") and $uurl =~ /^(\w+):/) {
+ $proto = $1;
+ $durl =~ s/^\w+::/$proto::/;
+ }
+ $index = "$proto://$hostname/index.html";
+ ($to,$from,$file) = split('/',$file);
$filename = strip_path($P{filename});
$mfrom = $from;
$mto = $to;
$data = "$dkeydir/$P{dkey}/data";
$size = $bytes = -s $data;
return unless $size;
- $warning =
- "Please avoid download with Internet Explorer, ".
- "because it has too many bugs.\n".
- "We recommend Firefox or wget.";
+ if ($nowarning) {
+ $warning = '';
+ } else {
+ $warning =
+ "Please avoid download with Internet Explorer, ".
+ "because it has too many bugs.\n".
+ "We recommend Firefox or wget.";
+ }
if ($filename =~ /\.(tar|zip|7z|arj|rar)$/) {
$warning .= "\n\n".
"$filename is a container file.\n".
} else {
$autodelete = '';
}
- $mimefilename = $filename;
- if ($mimefilename =~ s{([_\?\=\x00-\x1F\x7F-\xFF])}{sprintf("=%02X",ord($1))}eog) {
- $mimefilename =~ s/ /_/g;
- $mimefilename = '=?UTF-8?Q?'.$mimefilename.'?=';
- }
+
+ if (-s $keyring) {
+ $mimefilename = '';
+ } else {
+ $mimefilename = $filename;
+ if ($mimefilename =~ s/([_\?\=\x00-\x1F\x7F-\xFF])/sprintf("=%02X",ord($1))/eog) {
+ $mimefilename =~ s/ /_/g;
+ $mimefilename = '=?UTF-8?Q?'.$mimefilename.'?=';
+ }
+ }
unless ($fileid = readlink("$dkeydir/$P{dkey}/id")) {
my @s = stat($data);
}
$header .= "X-FEX-Client-Address: $fra\n" if $fra;
$header .= "X-FEX-Client-Agent: $fua\n" if $fua;
- foreach my $u (@durl) {
+ foreach my $u (@durl?@durl:($durl)) {
my $durl = sprintf("%s/%s/%s",$u,$P{dkey},normalize_filename($filename));
$header .= "X-FEX-URL: $durl\n" unless -s $keyring;
$download .= "$durl\n";
if ($sender_from) {
map { s/^From: <$mfrom/From: <$sender_from/ } $header;
open $sendmail,'|-',$sendmail,$mto,$bcc
- or http_die("cannot start sendmail - $!\n");
+ or http_die("cannot start sendmail - $!");
} else {
# for special remote domains do not use same domain in From,
# because remote MTA will probably reject this e-mail
{
$header =~ s/(From: <)\Q$mfrom\E(.*?)\n/$1$admin$2\nReply-To: $mfrom\n/;
open $sendmail,'|-',$sendmail,$mto,$bcc
- or http_die("cannot start sendmail - $!\n");
+ or http_die("cannot start sendmail - $!");
} else {
open $sendmail,'|-',$sendmail,'-f',$mfrom,$mto,$bcc
- or http_die("cannot start sendmail - $!\n");
+ or http_die("cannot start sendmail - $!");
}
}
if ($comment =~ s/^!(shortmail|\.)!\s*//i
'$disclaimer'
));
}
+ $body =~ s/\n\n+/\n\n/g;
if (-s $keyring) {
$enc_body = gpg_encrypt($body,$to,$keyring,$from);
}
"Content-Transfer-Encoding: 8bit\n";
}
print {$sendmail} $header,"\n",$body;
- close $sendmail
- or $! and http_die("cannot send notification e-mail (sendmail error $!)\n");
- return $to;
+ close $sendmail and return $to;
+ http_die("cannot send notification e-mail (sendmail error $!)");
}
projects / fex.git / blobdiff