From e60096926213ce02293a261254ff065cae44c1c8 Mon Sep 17 00:00:00 2001 From: fextracker Date: Tue, 16 Jun 2015 22:08:16 +0200 Subject: [PATCH] Original release 20150615 2015-06-10: fexsrv: fixed warning with https and SIGCHLD 2015-05-16: fexsrv/dop: added active and passive redirect support 2015-05-12: fuc: fixed bug undefined subroutine end_html 2015-04-30: fex_cleanup: fixed bug runtime error with mtime (symlinks) 2015-04-24: fixed bug wrong quota calculation for uploads 2015-04-23: fex_cleanup: follow symbolic links if they contain a / 2015-04-22: fexsend: 60 s timeout for file transfer socket (sys)write 2015-04-22: fup: fixed bug fexsend hangs with SKEY or GKEY recipient URL 2015-04-02: fixed several severe bugs in install script 2015-04-01: group name may only contain (some) ASCII characters 2015-03-29: fop: fixed bug no more download from same (recipient) ip 2015-03-18: added local URL redirect service 2015-03-08: fup: fixed bug uninitialized value $address if alias address is 2015-03-08: used twice 2015-03-07: disallow email addresses starting with "-" 2015-03-07: fex_cleanup: do not terminate on sendmail error 2015-03-01: no file name in email subject if notification is encrypted 2015-02-28: fexsrv: restrict HTTP header to 64 kB ($bs) and POST (not fup) to 2015-02-28: 128 MB 2015-02-27: no more usage of CGI.pm at all 2015-02-25: fup: added $auth_hook 2015-02-24: fac(CGI): no more usage of CGI.pm 2015-02-18: fuc: fixed bug no gpg usage help 2015-02-17: fexsend: check SSLeay version and adjust SSL_verify_mode 2015-02-16: fup: save upload URL in spool 2015-02-16: in notification+reminder emails use same protocol for download URL 2015-02-16: like in upload 2015-02-08: rup: fixed various bugs (not working at all) 2015-02-05: fup: fixed bug cannot send to groups 2015-01-27: fup: set autodelete=no if sender == recipient 2015-01-27: (use case: provide download link for mailing lists) 2015-01-27: new fex.ph config variable $fex_yourself (default yes) 2015-01-25: fexsend: fixed bug cannot forward a file name with "&" 2015-01-21: main user is always first member of a new group 2015-01-21: substituted CGI::Carp with web error handler via PERLINIT environment --- bin/fac | 42 +- bin/fbm | 2 +- bin/fex_cleanup | 88 +-- bin/fexget | 45 +- bin/fexsend | 157 +++-- bin/fexsrv | 159 ++++- bin/fexwall | 2 +- bin/l | 13 +- bin/logwatch | 28 +- bin/sexsend | 2 +- bin/zz | 8 +- cgi-bin/fac | 1246 ++++++++++++++++++++++----------------- cgi-bin/foc | 15 +- cgi-bin/fop | 38 +- cgi-bin/fuc | 63 +- cgi-bin/fup | 298 +++++----- cgi-bin/fur | 31 +- cgi-bin/pup | 16 +- cgi-bin/rup | 34 +- cgi-bin/sex | 42 +- doc/Changes | 38 +- doc/SSL | 2 + doc/concept | 4 +- doc/new | 14 +- doc/version | 2 +- htdocs/FAQ.html | 12 + htdocs/FAQ/admin.faq | 12 +- htdocs/FAQ/meta.faq | 14 +- htdocs/FAQ/user.faq | 11 +- htdocs/download/fexget | 45 +- htdocs/download/fexsend | 157 +++-- htdocs/download/sexsend | 2 +- htdocs/features.html | 69 --- htdocs/index.html | 7 +- htdocs/version | 2 +- install | 158 +++-- lib/dop | 8 +- lib/fex.ph | 41 +- lib/fex.pp | 316 +++++++--- lib/fup.pl | 4 +- 40 files changed, 1857 insertions(+), 1390 deletions(-) create mode 100644 htdocs/FAQ.html delete mode 100644 htdocs/features.html diff --git a/bin/fac b/bin/fac index 0946704..cec687a 100755 --- a/bin/fac +++ b/bin/fac @@ -43,7 +43,7 @@ unless ($<) { umask 077; # import from fex.pp -our ($FEXHOME,$FHS,$hostname,$spooldir,$logdir,$akeydir,$docdir); +our ($FEXHOME,$FHS,$hostname,$spooldir,@logdir,$akeydir,$docdir); our ($durl,@durl,$mdomain,$admin,$mailmode); our ($autodelete,$keep_default,$keep_max,$recipient_quota,$sender_quota); our (@local_rdomains); @@ -198,7 +198,7 @@ if ($opt_M) { # show logfile if ($opt_w) { - $log = "$logdir/fexsrv.log"; + $log = $logdir[0]."/fexsrv.log"; warn "$0: polling $log\n\n"; exec "$FEXHOME/bin/logwatch",$log; die "$0: logwatch not found\n"; @@ -401,10 +401,10 @@ if ($opt_A) { } # show config -if ($opt_v) { +if ($opt_v and not @ARGV) { print "config from $FEXLIB/fex.ph :\n"; print " spooldir = $spooldir\n"; - print " logdir = $logdir\n"; + print " logdir = @logdir\n"; print " docdir = $docdir\n"; print " durl = @durl\n"; print " admin = $admin\n"; @@ -433,26 +433,27 @@ if ($opt_v) { # add user or show user config if ($opt_u) { + chdir $spooldir or die "$0: cannot chdir $spooldir = $!\n"; if ($opt_u = shift @ARGV) { $user = lc $opt_u; $user .= '@'.$mdomain if $mdomain and $user !~ /@/; $id = shift @ARGV; - $idf = "$spooldir/$user/@"; + $idf = "$user/@"; if (open $idf,$idf) { chomp($ido = <$idf>||''); close $idf; } unless ($id) { - die "$0: $user is not a FEX user\n" unless -f "$spooldir/$user/@"; + die "$0: $user is not a regular FEX user\n" unless -f "$user/@"; showuser($user,$ido); exit; } unless ($user =~ /\w@[\w.-]+\.[a-z]+$/) { die "$0: $user is not a valid email-address!\n"; } - unless (-d "$spooldir/$user") { - mkdir "$spooldir/$user",0755 - or die "$0: cannot mkdir $spooldir/$user - $!\n"; + unless (-d $user) { + mkdir $user,0755 + or die "$0: cannot mkdir $user - $!\n"; } open F,">$idf" or die "$0: cannot write $idf - $!\n"; print F $id,"\n"; @@ -460,7 +461,7 @@ if ($opt_u) { showuser($user,$id); } else { print "Users in $spooldir:\n"; - foreach $user (glob "$spooldir/*/@") { + foreach $user (glob "*/@") { $user =~ s:.*/(.+)/@:$1:; print "$user\n"; } @@ -533,7 +534,7 @@ if ($opt_q) { $user = lc $opt_q; $user .= '@'.$mdomain if $mdomain and $user !~ /@/; unless (-d "$spooldir/$user") { - die "$0: $user is not a regular FEX user\n"; + die "$0: $user is not a FEX user\n"; } quota($user,@ARGV); exit; @@ -637,7 +638,7 @@ usage(3); sub showuser { my $user = shift; my $id = shift; - my ($keep,$autodelete,$notification); + my ($keep,$autodelete,$notification,$login); $user .= '@'.$mdomain if $mdomain and $user !~ /@/; @@ -646,6 +647,14 @@ sub showuser { printf "%s/%s\n",$fup,b64("from=$user&id=$id"); # printf "%s/%s\n",$fup,b64("from=$user&to=$user&id=$id&submit=."); print "spool: $spooldir/$user/\n"; + if ($login_check and $login = readlink "$user/.login") { + my $lc = &$login_check($login); + if ($lc) { + print "login: $login\n"; + } else { + print "login: DELETED\n"; + } + } printf "fex yourself web default: %s\n", -e "$spooldir/$user/\@FEXYOURSELF" ? 'yes' : 'no'; printf "persistent: %s\n", @@ -712,7 +721,7 @@ sub fupstat { my ($log,$u,$d,$z); my $Z = 0; - if (-t) { $log = "$logdir/fup.log" } + if (-t) { $log = $logdir[0].'/fup.log' } else { $log = '>&=STDIN' } open $log,$log or die "$0: cannot open $log - $!\n"; @@ -749,7 +758,7 @@ sub fopstat { my ($log,$u,$d,$z); my (%user,%domain,%du); - if (-t) { $log = "$logdir/fop.log" } + if (-t) { $log = $logdir[0].'/fop.log' } else { $log = '>&=STDIN' } open $log,$log or die "$0: cannot open $log - $!\n"; @@ -789,11 +798,6 @@ sub cpa { } -sub mtime { - my @s = lstat shift; - return @s ? $s[9] : undef; -} - sub check_admin { my $admin_id = slurp("$spooldir/$admin/@") or diff --git a/bin/fbm b/bin/fbm index b33fd6f..1750641 100755 --- a/bin/fbm +++ b/bin/fbm @@ -20,7 +20,7 @@ use constant M => 2**20; our ($SH,$windoof,$sigpipe,$useragent); our ($FEXSERVER); -our $version = 20150120; +our $version = 20150615; # server defaults my $server = 'fex.rus.uni-stuttgart.de'; diff --git a/bin/fex_cleanup b/bin/fex_cleanup index c54b2e0..1adec4e 100755 --- a/bin/fex_cleanup +++ b/bin/fex_cleanup @@ -38,7 +38,7 @@ $| = 1; # use fex.ph for site configuration! our ($FEXHOME); -our ($spooldir,$logdir,$docdir); +our ($spooldir,@logdir,$docdir); our ($akeydir,$ukeydir,$dkeydir,$skeydir,$gkeydir,$xkeydir,$lockdir); our ($durl,$debug,$autodelete,$hostname,$admin,$admin_pw,$bcc); $keep_default = 5; @@ -46,6 +46,8 @@ $keep_default = 5; # load common code, local config : $HOME/lib/fex.ph require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n"; +my $logdir = $logdir[0]; + # localized functions # (needed for reminder and account reactivation e-mails) foreach my $lf (glob "$FEXHOME/locale/*/lib/lf.pl") { require $lf } @@ -64,13 +66,13 @@ $today = time; $isodate = isodate($today); chdir $spooldir or die "$0: $spooldir - $!\n"; -open L,">>$logdir/cleanup.log"; +# open L,">>$logdir/cleanup.log"; # clean up regular spool opendir $spooldir,'.' or die "$0: $spooldir - $!\n"; while ($to = readdir $spooldir) { - next if $to !~ /@/ or -l $to; - if (@demo and -f "$to/.demo" and time > mtime("$to/.demo")+$demo[1]*DS) { + next if $to !~ /@/ or $_ = readlink($to) and not /\//; + if (@demo and -f "$to/.demo" and time > lmtime("$to/.demo")+$demo[1]*DS) { logdel($to,"demo user $to deleted"); next; } @@ -117,7 +119,7 @@ while ($to = readdir $spooldir) { if ($lc) { if (-f "$user/\@~" and not "$user/@") { rename "$user/\@~","$user/@" unless $opt_d; - logv("$isodate $user reanimated (login_check)"); + logv("$user reanimated (login_check)"); } } else { rename "$user/@","$user/\@~" unless $opt_d; @@ -145,7 +147,7 @@ if (chdir $ukeydir and opendir D,'.') { while ($file = readdir D) { next if $file eq '.' or $file eq '..'; if (($link = readlink $file and not -e "$link/upload" - or -f $file and time > mtime($file)+DS)) { + or -f $file and time > lmtime($file)+DS)) { logdel($file,".ukeys/$file deleted"); } } @@ -155,7 +157,7 @@ if (chdir $ukeydir and opendir D,'.') { # clean up authorization key lookup directory if (chdir $akeydir and opendir D,'.') { while ($file = readdir D) { - if (-l $file and time > mtime($file)+DS) { + if (-l $file and time > (lmtime($file)||0)+DS) { logdel($file,".akeys/$file deleted"); } } @@ -176,7 +178,7 @@ if (chdir $xkeydir and opendir D,'.') { # clean up lock directory if (chdir $lockdir and opendir D,'.') { while ($file = readdir D) { - if (-f $file and time > mtime($file)+DS) { + if (-f $file and time > lmtime($file)+DS) { logdel($file,".locks/$file deleted"); } } @@ -187,7 +189,7 @@ if (chdir $lockdir and opendir D,'.') { if (chdir "$spooldir/.error" and opendir D,'.') { while ($file = readdir D) { if (-f $file) { - $mtime = mtime($file); + $mtime = lmtime($file); if ($mtime and $today > 10*$keep_default*DS+$mtime) { if ($opt_d) { print "unlink .error/$file\n" } else { logdel($file,".error/$file deleted") } @@ -198,10 +200,10 @@ if (chdir "$spooldir/.error" and opendir D,'.') { } # clean up debug directory -if (chdir "$logdir/.debug" and opendir D,'.') { +if (chdir "$spooldir/.debug" and opendir D,'.') { while ($file = readdir D) { if (-f $file) { - $mtime = mtime($file); + $mtime = lmtime($file); if ($mtime and $today > $keep_default*DS+$mtime) { # logdel($file,".debug/$file deleted"); if ($opt_d) { print "unlink .debug/$file\n" } @@ -257,7 +259,7 @@ foreach $subuser (glob '*/@MAINUSER') { # clean up old OKEYs chdir $spooldir; foreach my $okey (glob '*/@OKEY/*') { - if (time > mtime($okey)+30*DS) { + if (time > lmtime($okey)+30*DS) { logdel($okey,"$okey deleted"); } } @@ -301,7 +303,7 @@ if (chdir $gkeydir and opendir D,'.') { if (chdir "$spooldir/.reg" and opendir D,'.') { while ($file = readdir D) { if (-f $file) { - $mtime = mtime($file); + $mtime = lmtime($file); if ($mtime and $today > $mtime+DS) { logdel($file,".reg/$file deleted"); } @@ -346,7 +348,7 @@ if ($account_expire and $account_expire =~ /^(\d+)/) { next if $user =~ /^(fexmaster|fexmail)/ or $user eq $admin; next if -l "$user/.login"; - if (time > mtime($user)+$expire*DS) { + if (time > lmtime($user)+$expire*DS) { # print "$spooldir/$user\n"; my $locale = readlink "$user/\@LOCALE"; $locale = 'english' unless $locale and $reactivation{$locale}; @@ -358,8 +360,6 @@ if ($account_expire and $account_expire =~ /^(\d+)/) { } } -close L; - # vhosts exit if $opt_V; if (%vhost) { @@ -374,7 +374,8 @@ if (%vhost) { } } -if ($notify_newrelease or not defined $notify_newrelease) { +if ($notify_newrelease and $notify_newrelease !~ /^no$/i + or not defined $notify_newrelease) { $notify_newrelease ||= $admin; $newnew = $new = ''; $snew = $FEXHOME.'/doc/new'; @@ -384,10 +385,10 @@ if ($notify_newrelease or not defined $notify_newrelease) { else { $qn = "new?$hostname:0" } for (1..3) { sleep rand(10); - $newnew = `wget -qO- http://fex.rus.uni-stuttgart.de/$qn 2>/dev/null`; - last if $newnew =~ /release/; $newnew = `wget -qO- http://fex.belwue.de/$qn 2>/dev/null`; last if $newnew =~ /release/; + # $newnew = `wget -qO- http://fex.rus.uni-stuttgart.de/$qn 2>/dev/null`; + # last if $newnew =~ /release/; }; if ($newnew =~ /release/) { if ($newnew ne $new) { @@ -432,12 +433,12 @@ sub cleanup { if ($file =~ /\/ADDRESS_BOOK/) { logdel($file,"$file deleted"); } elsif (-d $file and not -f $data) { - if ($mtime = mtime("$file/upload")) { + if ($mtime = lmtime("$file/upload")) { if ($today > $mtime+DS) { verbose("rmrf $file (today=$today mtime_upload=$mtime)"); logdel($file,"$file deleted"); } - } elsif ($mtime = mtime("$file/error")) { + } elsif ($mtime = lmtime("$file/error")) { if ($today > 3*$keep*DS+$mtime) { verbose("rmrf $file (today=$today mtime_error=$mtime keep=$keep)"); logdel($file,"$file deleted"); @@ -449,19 +450,19 @@ sub cleanup { $delay = autodelete($file); $delay = 1 if $delay !~ /^\d+$/; $delay--; - $mtime = mtime($download); + $mtime = lmtime($download); if ($mtime and $today > $delay*DS+$mtime and logdel($data,"$data deleted")) { if (open $ef,'>',$ef) { printf {$ef} "%s has been autodeleted after download at %s\n", - filename($file),isodate(mtime($download)); + filename($file),isodate(lmtime($download)); close $ef; } } } elsif (-f $data) { my $reactivation = $file =~ m{/\Q$admin/reactivation.txt\E$}; $warn = $reactivation ? $keep-5 : $keep-2; - $mtime = mtime("$file/filename") || mtime($data) || 0; + $mtime = lmtime("$file/filename") || lmtime($data) || 0; if ($today > $mtime+$keep*DS) { if ($account_expire and $reactivation) { if ($account_expire =~ /delete/) { @@ -514,7 +515,7 @@ sub cleanup { chomp ($comment = <$c>||''); close $c; } - &{$notify{$locale}}( + if (&{$notify{$locale}}( status => 'remind', dkey => $dkey, filename => filename($file), @@ -522,10 +523,13 @@ sub cleanup { comment => $comment, warn => int(($mtime-$today)/DS)+$keep, autodelete => autodelete($file), - ); - open $notify,'>',$notify; - close $notify; - print "sent reminder for $file\n" if -t or $opt_v; + )) { + open $notify,'>',$notify; + close $notify; + print "sent reminder for $file\n" if -t or $opt_v; + } else { + warn "$0: reminder notification for $file failed\n"; + } } } } @@ -545,11 +549,6 @@ sub autodelete { return $autodelete||$::autodelete; } -sub mtime { - my @s = lstat shift; - return @s ? $s[9] : undef; -} - sub logdel { my ($file,$msg) = @_; my $status = 0; @@ -560,8 +559,8 @@ sub logdel { if ($status = rmrf($file)) { logv($msg); } else { - print L "$isodate $file DEL FAILED : $!\n"; - warn "$file DEL FAILED : $!\n" if -t or $opt_v; + logv("$file DEL FAILED : $!"); + warn "$file DEL FAILED : $!\n" if -t or $opt_v; } } @@ -571,8 +570,17 @@ sub logdel { sub logv { my $msg = shift; - print L "$isodate $msg\n" unless $opt_d; + print "$msg\n" if -t or $opt_v; + + unless ($opt_d) { + foreach my $ld (@logdir) { + if (open my $log,">>$ld/cleanup.log") { + print {$log} "$isodate $msg\n"; + close $log; + } + } + } } @@ -585,3 +593,9 @@ sub verbose { } } } + + +sub lmtime { + my @s = lstat(shift); + return @s?$s[9]:0; +} diff --git a/bin/fexget b/bin/fexget index 034ced1..6c0126f 100755 --- a/bin/fexget +++ b/bin/fexget @@ -30,7 +30,7 @@ our $SH; our ($fexhome,$idf,$tmpdir,$windoof,$useragent); our ($xv,%autoview); our $bs = 2**16; # blocksize for tcp-reading and writing file -our $version = 20150120; +our $version = 20150615; our $CTYPE = 'ISO-8859-1'; our $fexsend = $ENV{FEXSEND} || 'fexsend'; @@ -157,48 +157,7 @@ if ($opt_H) { exit; } -# set SSL/TLS options -$SSL{SSL_verify_mode} = $ENV{SSLVERIFY} if defined($ENV{SSLVERIFY}); -foreach my $opt (qw( - SSL_version - SSL_cipher_list - SSL_verify_mode - SSL_ca_path - SSL_ca_file) -) { - my $env = uc($opt); - $env =~ s/_//g; - $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); -} - -if ($SSL{SSL_verify_mode}) { - &search_ca; - unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { - die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; - } -} elsif (defined($SSL{SSL_verify_mode})) { - # user has set SSLVERIFY=0 ! -} else { - &search_ca; - $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; -} - -sub search_ca { - local $_; - return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; - foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { - if (-f) { - $SSL{SSL_ca_file} = $_; - return; - } - } - foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { - if (-f) { - $SSL{SSL_ca_path} = $_; - return; - } - } -} +&get_ssl_env; my $ffl = "$tmpdir/fexget"; # F*EX files list (cache) diff --git a/bin/fexsend b/bin/fexsend index 607d139..a0eabe1 100755 --- a/bin/fexsend +++ b/bin/fexsend @@ -37,7 +37,7 @@ our ($tpid,$frecipient); our ($FEXID,$FEXXX,$HOME); our (%alias); our $chunksize = 0; -our $version = 20150120; +our $version = 20150615; our $_0 = $0; our $DEBUG; @@ -199,6 +199,10 @@ and then copy-forward it with: $0 -b # other\@address Where # is the file number. +You can list an uploaded file in more detail with + $0 -l # +Where # is the file number. + If you want to modify the keep time, comment or auto-delete behaviour of an already uploaded file then you first have to query the file number with: $0 -l @@ -625,8 +629,10 @@ sub init_id { if ($fexcgi =~ /\?/) { $from = $1 if $fexcgi =~ /\bfrom=(.+?)(&|$)/i; $id = $1 if $fexcgi =~ /\bid=(.+?)(&|$)/i; - $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i; - $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i; + # $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i; + # $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i; + die "$0: cannot use GKEY URL in ID file\n" if $fexcgi =~ /gkey=/i; + die "$0: cannot use SKEY URL in ID file\n" if $fexcgi =~ /skey=/i; $fexcgi =~ s/\?.*//; } unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) { @@ -1001,6 +1007,9 @@ sub list { else { $dkey = '' } # $_ = encode_utf8($_); s/<.*?>//g; + s/&/&/g; + s/"/\"/g; + s/</) { - if (/^alias \Q$to\E\s/i) { - chomp; - s/\s*#.*//; - s/\(.*?\)//; - s/\s+$//; - s/.*\s+//; - s/[<>]//g; - if (/,/) { - warn "$0: ignoring mutt multi-alias $to = $alias\n"; - last; - } - if (/@/) { - $alias = $_; - warn "$0: found mutt alias $to = $alias\n"; - last; - } - } - } - close $ma; - $to = $alias; + elsif ($to !~ /@/ and $to ne $from) { + $to = get_mutt_alias($to); } } } $to = join(',',grep /./,@to) or exit; - warn "Server/User: $fexcgi/$from\n" unless $opt_q; + # warn "Server/User: $fexcgi/$from\n" unless $opt_q; if ( not $skey and not $gkey + and $from ne $to and $features =~ /CHECKRECIPIENT/ and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/ ) { @@ -1497,7 +1485,7 @@ sub send_fex { sub forward { my (@r); my ($to,$n,$dkey,$file,$req); - my $status = 1; + my ($status,$fp); local $_; # look for single @ in arguments @@ -1512,6 +1500,9 @@ sub forward { # if ($windoof and not @ARGV) { &inquire } $to = pop @ARGV or die $usage; $to = $from if $to eq '.'; + if ($to !~ /@/ and $to ne $from) { + $to = get_mutt_alias($to); + } open $fexlist,$fexlist or die "$0: $fexlist - $!\n"; while (<$fexlist>) { @@ -1545,16 +1536,12 @@ sub forward { $req .= " HTTP/1.1"; sendheader("$server:$port",$req); http_response(); + $fp = $file; + $fp =~ s/[^\w_.-]/.+/g; # because of UTF8 filename + $status = 1; while (<$SH>) { - if ($opt_v) { - print; - $status = 0 if /\Q"$file"/; - } else { - if (/\Q"$file"/) { - print; - $status = 0; - } - } + $status = 0 if /"$fp"/; + print if $opt_v or /"$fp"/; } if ($status) { @@ -1723,7 +1710,11 @@ sub get_xx { if (/^n/i) { print "keeping $transferfile\n"; } else { - system("tar xvf $transferfile && rm $transferfile"); + my $untar = "tar xvf"; + # if ($> == 0 and `tar --help 2>&1` =~ /gnu/) { + # $untar = "tar --no-same-owner -xvf"; + # } + system("$untar $transferfile && rm $transferfile"); die "$0: error while untaring, see $transferfile\n" if -f $transferfile; } } else { @@ -2058,8 +2049,11 @@ sub formdatapost { print $rcamel[0] if ${'opt_+'}; + $SIG{ALRM} = sub { retry("timed out") }; while (my $b = read $file,$buf,$bs) { - print {$SH} $buf or &sigpipehandler; + alarm($timeout*2); + syswrite $SH,$buf or &sigpipehandler; + alarm(0); $bytes += $b; if ($filesize > 0 and $bytes+$seek > $filesize) { die "$0: $file filesize has grown while uploading\n"; @@ -2611,21 +2605,27 @@ sub ts { sub sigpipehandler { - $SIG{ALRM} = sub { }; + retry("died"); +} + +sub retry { + my $reason = shift; + local $SIG{ALRM} = sub { }; + if (fileno $SH) { alarm(1); - @_ = <$SH>; + my @r = <$SH>; alarm(0); kill 9,$tpid if $tpid; - if (@_ and $opt_v) { - die "\n$0: ($$) server error: @_\n"; + if (@r and $opt_v) { + die "\n$0: ($$) server error: @r\n"; } - if (@_ and $_[0] =~ /^HTTP.* \d+ (.*)/) { + if (@r and $r[0] =~ /^HTTP.* \d+ (.*)/) { die "\n$0: server error: $1\n"; } } $timeout *= 2; - warn "\n$0: connection to $server died\n"; + warn "\n$0: connection to $server $reason\n"; warn "retrying after $timeout seconds...\n"; sleep $timeout; if ($windoof) { exec $^X,$0,@_ARGV } @@ -2736,6 +2736,37 @@ sub fileid { } +sub get_mutt_alias { + my $to = shift; + my $ma = $HOME.'/.mutt/aliases'; + my $alias; + local $_; + + open $ma,$ma or return $to; + while (<$ma>) { + if (/^alias \Q$to\E\s/i) { + chomp; + s/\s*#.*//; + s/\(.*?\)//; + s/\s+$//; + s/.*\s+//; + s/[<>]//g; + if (/,/) { + warn "$0: ignoring mutt multi-alias $to = $alias\n"; + last; + } + if (/@/) { + $alias = $_; + warn "$0: found mutt alias $to = $alias\n"; + last; + } + } + } + close $ma; + return ($alias||$to); +} + + # collect file meta data (filename, inode, mtime) sub fmd { my @files = @_; @@ -2815,6 +2846,7 @@ sub http_response { unless (defined $_ and /\w/) { die "$0: no response from server\n"; } + print "<-- $_\n" if $opt_v; s/\r?\n//; # CGI fatalsToBrowser if (/^HTTP.* 500/) { @@ -2825,9 +2857,12 @@ sub http_response { unless (/^HTTP.* 200/) { $error = $_; $error =~ s/HTTP.[\s\d.]+//; - if ($opt_v) { - print "<-- $_"; - print "<-- $_" while <$SH>; + @r = <$SH> unless @r; + @r = () unless @r; + foreach (@r) { + chomp; + $error .= "\n".$_ if /^Location/; + print "<-- $_\n" if $opt_v; } die "$0: server error: $error\n"; } @@ -2937,12 +2972,6 @@ sub serverconnect { my $connect = "CONNECT $server:$port HTTP/1.1"; local $_; - if ($opt_v and $port == 443 and %SSL) { - foreach my $v (keys %SSL) { - printf "%s => %s\n",$v,$SSL{$v}; - } - } - if ($proxy) { tcpconnect(split(':',$proxy)); if ($port == 443) { @@ -2954,8 +2983,7 @@ sub serverconnect { unless (/^HTTP.1.. 200/) { die "$0: proxy error : $_"; } - eval "use IO::Socket::SSL"; - die "$0: cannot load IO::Socket::SSL\n" if $@; + &enable_ssl; $SH = IO::Socket::SSL->start_SSL($SH,%SSL); } } else { @@ -2978,8 +3006,7 @@ sub tcpconnect { if ($port == 443) { # eval "use IO::Socket::SSL qw(debug3)"; - eval "use IO::Socket::SSL"; - die "$0: cannot load IO::Socket::SSL\n" if $@; + &enable_ssl; $SH = IO::Socket::SSL->new( PeerAddr => $server, PeerPort => $port, @@ -3004,6 +3031,18 @@ sub tcpconnect { } +sub enable_ssl { + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143'; + if ($opt_v) { + foreach my $v (keys %SSL) { + printf "%s => %s\n",$v,$SSL{$v}; + } + } +} + + sub sendheader { my $sp = shift; my @head = @_; diff --git a/bin/fexsrv b/bin/fexsrv index 27e3318..11911ff 100755 --- a/bin/fexsrv +++ b/bin/fexsrv @@ -1,4 +1,4 @@ -#!/usr/bin/perl -wT +#!/usr/bin/perl -T # fexsrv : web server for F*EX service # @@ -9,9 +9,50 @@ use 5.008; use Socket; use IO::Handle; use Fcntl qw':flock :seek'; - -# stunnel workaround -BEGIN { $SIG{CHLD} = "DEFAULT" } +use warnings; + +BEGIN { + # stunnel workaround + $SIG{CHLD} = "DEFAULT"; + $ENV{PERLINIT} = q{ + unshift @INC,(getpwuid($<))[7].'/perl'; + # web error handler + $SIG{__DIE__} = $SIG{__WARN__} = sub { + my $info = ''; + my $url = $ENV{REQUEST_URL}||''; + my @d = localtime time; + my $time = sprintf('%d-%02d-%02d %02d:%02d:%02d', + $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]); + if ($admin) { + my $mailto = "mailto:$admin?subject=fex%20bug"; + $info = "

send this error to $admin

"; + } + $_ = join("\n",@_); + chomp; + s/&/&/g; + s/", + "

INTERNAL ERROR in $0

", + "
\n$_\n
\n

", + "$url\n

", + "$time\n

", + "$info\n

", + "" + ); + $length = length; + unless ($HTTP_HEADER) { + print "HTTP/1.0 200 ERROR\r\n"; + print "Content-Type: text/html\r\n"; + print "Content-Length: $length\r\n"; + print "\r\n"; + } + print; + exit 99; + } + }; + eval $ENV{PERLINIT}; +} # use BSD::Resource; # setrlimit(RLIMIT_CPU,999,999) or die "$0: $!\n"; @@ -25,10 +66,10 @@ if (@ARGV and $ARGV[0] eq 'stunnel' and $ENV{REMOTE_HOST} =~ /(.+)/) { if ($ENV{KEEP_ALIVE}) { $keep_alive = $ENV{KEEP_ALIVE}; } else { - %ENV = (); # clean environment + %ENV = ( PERLINIT => $ENV{PERLINIT} ); # clean environment } -$ENV{HOME} = (getpwuid($<))[7] or die "$0: no HOME\n"; +$ENV{HOME} = (getpwuid($<))[7] or die "no HOME"; # fexsrv MUST be run with full path! if ($0 =~ m:^(/.+)/bin/fexsrv:) { @@ -50,16 +91,16 @@ foreach my $lib ( # import from fex.pp our ($hostname,$debug,$timeout,$max_error,$max_error_handler); -our ($spooldir,$logdir,$docdir,$xkeydir,$lockdir); -our ($force_https,$default_locale,$bs,$adlm); +our ($spooldir,@logdir,$docdir,$xkeydir,$lockdir); +our ($force_https,$default_locale,$bs,$MB,$adlm); our (@locales); # load common code (local config: $FEXHOME/lib/fex.ph) -require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n"; +require "$FEXLIB/fex.pp" or die "cannot load $FEXLIB/fex.pp - $!\n"; chdir $spooldir or http_die("$0: $spooldir - $!\n"); -our $log = "$logdir/fexsrv.log"; +our $log = 'fexsrv.log'; our $error = 'F*EX ERROR'; our $htmlsource; our $hid = ''; # header ID @@ -67,8 +108,9 @@ our @log; $0 = untaint($0); -$ENV{GATEWAY_INTERFACE} = 'CGI/1.1'; +$ENV{GATEWAY_INTERFACE} = 'CGI/1.1f'; $ENV{SERVER_NAME} = $hostname; +$ENV{REQUEST_METHOD} = ''; $ENV{QUERY_STRING} = ''; $ENV{HTTP_COOKIE} = ''; $ENV{PATH_INFO} = ''; @@ -119,7 +161,7 @@ else { # HTTP connect else { $ENV{PROTO} = 'http'; - my $sa = getpeername(STDIN) or die "$0: no network stream on STDIN\n"; + my $sa = getpeername(STDIN) or die "no network stream on STDIN\n"; if (sockaddr_family($sa) == AF_INET) { ($ENV{REMOTE_PORT},$iaddr) = sockaddr_in($sa); $ENV{REMOTE_ADDR} = $ra = inet_ntoa($iaddr); @@ -129,11 +171,11 @@ else { $^W = 0; eval 'use Socket6'; $^W = 1; http_error(503) if $@; ($ENV{REMOTE_PORT},$iaddr) = unpack_sockaddr_in6($sa); - $ENV{REMOTE_ADDR} = $ra = inet_ntop(AF_INET6, $iaddr); + $ENV{REMOTE_ADDR} = $ra = inet_ntop(AF_INET6,$iaddr); $rh = gethostbyaddr($iaddr,AF_INET6); ($port) = unpack_sockaddr_in6(getsockname(STDIN)); } else { - die "$0: unknown IP version\n"; + die "unknown IP version\n"; } $port = 80 unless $port; } @@ -143,6 +185,7 @@ else { $ENV{HTTP_HOST} = ($port == 80 or $port == 443) ? $hostname : "$hostname:$port"; + $ENV{PORT} = $port; } if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra) { @@ -199,6 +242,10 @@ REQUEST: while (*STDIN) { $header{$1} = $2 if /(.+)\s*:\s*(.+)/; push @log,$_; } + if ($hl > $MB) { + fexlog($connect,@log,"OVERRUN"); + http_error(413); + } if (/^(GET \/|X-Forwarded-For|User-Agent)/i) { $hid .= $_."\n"; @@ -306,6 +353,7 @@ REQUEST: while (*STDIN) { } if ($request =~ /^(GET|HEAD|POST)\s+(.+)\s+(HTTP\/[\d\.]+$)/i) { + $ENV{REQUEST} = $_; $ENV{REQUEST_METHOD} = uc($1); $ENV{REQUEST_URI} = $uri = $cgi = $2; $ENV{HTTP_VERSION} = $protocol = $3; @@ -457,7 +505,9 @@ REQUEST: while (*STDIN) { if ($debug) { debuglog("ENV:\n"); foreach $var (sort keys %ENV) { - debuglog(sprintf " %s = >%s<\n",$var,$ENV{$var}); + if (defined($ENV{$var})) { + debuglog(sprintf " %s = >%s<\n",$var,$ENV{$var}); + } } debuglog("\n"); } @@ -473,12 +523,20 @@ REQUEST: while (*STDIN) { # prepare document file name if ($ENV{REQUEST_METHOD} =~ /^GET|HEAD$/) { + if (%redirect) { + foreach my $r (keys %redirect) { + if ($uri =~ /^\Q$r/) { + redirect($uri,$r); + exit; + } + } + } $doc = untaint($uri); $doc =~ s/%([\dA-F]{2})/unpack("a",pack("H2",$1))/ge; $doc =~ m:/\.\./: and http_error(403); $doc =~ s:^/+::; $doc =~ s/\?.*//; - if ($locale and -e "$docdir/locale/$locale/$doc") { + if ($locale and $locale ne 'english' and -e "$docdir/locale/$locale/$doc") { $doc = "$docdir/locale/$locale/$doc"; } else { $doc = "$docdir/$doc"; @@ -514,7 +572,7 @@ REQUEST: while (*STDIN) { fexlog($connect,@log,"FORBIDDEN"); http_error(403); } - unlink "$logdir/.error/$ra"; + unlink "$spooldir/.error/$ra"; # push @log,"DEBUG: locale=$locale locales=(@locales)"; fexlog($connect,@log,"EXEC $cgi"); eval { local $^W = 0; exec $cgi }; @@ -573,7 +631,7 @@ REQUEST: while (*STDIN) { or $doc =~ /(.+)\.tgz$/ and -f "$1.tar" or $doc =~ /(.+)\.gz$/ and -f $1) { - unlink "$logdir/.error/$ra"; + unlink "$spooldir/.error/$ra"; delete $ENV{SCRIPT_FILENAME}; $ENV{DOCUMENT_FILENAME} = $doc; require "$FEXLIB/dop"; @@ -628,6 +686,7 @@ REQUEST: while (*STDIN) { # read one text line unbuffered from STDIN sub getaline { my $line = ''; + my $n = 0; my $c; alarm($timeout); @@ -636,7 +695,12 @@ sub getaline { # (later exec would destroy line buffer) while (sysread STDIN,$c,1) { $line .= $c; + $n++; last if $c eq "\n"; + if ($n > $bs) { + fexlog($connect,@log,$line,"OVERRUN"); + http_error(413); + } } alarm(0); @@ -647,18 +711,20 @@ sub getaline { sub fexlog { my @log = @_; - if (open $log,">>$log") { - flock $log,LOCK_EX; - seek $log,0,SEEK_END; - print {$log} "\n",join("\n",@log),"\n"; - close $log; - } else { - http_die("$0: cannot write to $log - $!\n"); + + foreach my $logdir (@logdir) { + if (open $log,'>>',"$logdir/$log") { + flock $log,LOCK_EX; + seek $log,0,SEEK_END; + print {$log} "\n",join("\n",@log),"\n"; + close $log; + } else { + http_die("$0: cannot write to $logdir/$log - $!\n"); + } } } - sub badchar { my $bc = shift; @@ -711,6 +777,9 @@ sub http_error { } elsif ($error eq 404) { http_error_header("404 Not Found"); nvt_print("The requested URI $URI was not found on this server."); + } elsif ($error eq 413) { + http_error_header("413 Payload Too Large"); + nvt_print("Your HTTP header is too large."); } elsif ($error eq 416) { http_error_header("416 Requested Range Not Satisfiable"); } elsif ($error eq 503) { @@ -765,6 +834,44 @@ sub http_error_header { } +sub redirect { + my $uri = shift; + my $r = shift; + my $rr = $redirect{$r}; + my $newurl; + + $uri =~ s/\Q$r//; + + if ($rr =~ s/^!//) { + $newurl = $rr.$uri; + nvt_print( + "HTTP/1.1 301 Moved Permanently", + "Location: $newurl", + "Content-Length: 0", + "" + ); + } else { + if ($rr =~ /^http/) { + $newurl = $rr.$uri; + } else { + $newurl = "$ENV{PROTO}://$ENV{HTTP_HOST}$rr$uri"; + } + + http_header("200 OK"); + print html_header("$hostname page has moved"); + pq(qq( + '

Please use new URL: $newurl

' + '' + )); + } + if ($rr =~ /^http/) { + exit; + } else { + &reexec; + } +} + + sub badlog { my $request = shift; my @n; diff --git a/bin/fexwall b/bin/fexwall index 7004a53..c632e15 100755 --- a/bin/fexwall +++ b/bin/fexwall @@ -120,5 +120,5 @@ sub uniq { sub usage { print "usage: $0 \"SUBJECT\" < mail.text\n"; - exit shift; + exit shift||0; } diff --git a/bin/l b/bin/l index 93c4aca..1389931 100755 --- a/bin/l +++ b/bin/l @@ -22,10 +22,10 @@ $ENV{LC_CTYPE} = 'C'; # parse CLI arguments $opt_l = $opt_i = $opt_t = $opt_s = $opt_a = $opt_r = $opt_d = $opt_n = 0; $opt_L = $opt_N = $opt_c = $opt_u = $opt_S = $opt_R = $opt_z = $opt_h = 0; -$opt_U = 0; +$opt_U = $opt_x = 0; ${'opt_*'} = ${'opt_?'} = 0; $opt_m = $opt_f = $opt_F = $opt_D = ''; -&usage if !getopts('hdnlLNitcuarsUSRz*?m:f:D:F:') || $opt_h; +&usage if !getopts('hdnlLNitcuarsxUSRz*?m:f:D:F:') || $opt_h; $opt_z = 1 unless $opt_R; $opt_l = 1 if $0 eq 'll'; $opt_l = $opt_i = $opt_a = $opt_S = 1 if $0 eq 'lll'; @@ -167,6 +167,12 @@ sub collect { # traverse real subdirs if (-d $f and not -l $f) { $f =~ s:/*$:/:; + # skip other file systems on -x + if ($opt_x) { + my @pd = stat(dirname($f)); + my @sd = stat($f); + next if $pd[0] ne $sd[0]; + } collect(getfiles($f)); } @@ -545,7 +551,7 @@ sub fmatch { sub usage { - my $opts = '[-lastcuidnrzLRNS*] [-f format] [-D X:Y]'; + my $opts = '[-lastcuidnrzLRxNS*] [-f format] [-D X:Y]'; if ($0 ne 'lf') { print "usage: $0 $opts [-F regexp] [file...]\n"; } @@ -566,6 +572,7 @@ options: -l long list -z squeeze size field (slows down output) -L derefernce symbolic links -R recursive into subdirs + -x do not cross filesystem boundaries with -R -F find files matching case insensitive regexp -N show only normal (regular) files -S print statistics summary at end diff --git a/bin/logwatch b/bin/logwatch index 7ef1d4b..1b75a21 100755 --- a/bin/logwatch +++ b/bin/logwatch @@ -1,6 +1,5 @@ #!/usr/bin/perl -w -use Encode; use File::Basename; use Cwd 'abs_path'; use I18N::Langinfo qw'langinfo CODESET'; @@ -19,7 +18,7 @@ unless ($FEXLIB = $ENV{FEXLIB}) { die "$0: no $FEXLIB\n" unless -d $FEXLIB; # import from fex.pp -our ($logdir,$spooldir,$debug); +our (@logdir,$spooldir,$debug); # load common code, local config : $HOME/lib/fex.ph require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n"; @@ -27,7 +26,7 @@ require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n"; $CTYPE = langinfo(CODESET()); binmode(STDOUT,":encoding($CTYPE)"); -$log = shift || "$logdir/fexsrv.log"; +$log = shift || $logdir[0].'/fexsrv.log'; $ignore = join('|',qw( (CONNECT|CONTINUE).*(crawl|msnbot|obertux) @@ -40,9 +39,9 @@ $ignore = join('|',qw( GET./fup\?showstatus GET./FAQ/faq\.css GET./FAQ/jquery\.js - GET./10+.B GET.*Arrow\.gif GET./apple-touch + GET./browserconfig\.xml User-Agent:.*(Webnote|FeedFetcher|\w+bot|bot/|Website.Watcher|crawler|spider|searchme|Yandex|Slurp|ScoutJet|findlinks|urlmon|nagios) User-Agent:.fnb.*quak From:.*(msnbot|yandex|googlebot|webcrawler) @@ -132,7 +131,7 @@ for (;;) { printf " TO=\"%s\"\n",$to; $cgi = ''; if ($comment = slurp("$ddir/comment")) { - printf " COMMENT=\"%s\"\n",decode_utf8($comment,0)||''; + printf " COMMENT=\"%s\"\n",utf8decode($comment)||''; } if (not -f "$ddir/data" and $_ = slurp("$ddir/error")) { s/\n.*//s; @@ -146,12 +145,12 @@ for (;;) { read_skey($1); print "\n"; } + if ($debug and $pid and $cgi) { + &read_debug_log; + }; + $pid = $cgi = ''; } sleep 1; - if ($debug and $pid and $cgi) { - &read_debug_log; - $pid = $cgi = ''; - }; } @@ -164,7 +163,7 @@ sub read_debug_log { for (1..2) { sleep 1; - @log = `ls -rt $logdir/.debug/*_${pid}.$cgi 2>/dev/null`; + @log = `ls -rt $logdir[0]/.debug/*_${pid}.$cgi 2>/dev/null`; if ($log = $log[-1] and open $log,$log) { # binmode($log,":encoding(UTF-8)"); while (<$log>) { @@ -176,7 +175,7 @@ sub read_debug_log { $_ = <$log>; my $v = <$log>||''; $v =~ s/[\r\n]+//; - printf " %s=\"%s\"\n",$p,decode_utf8($v,0)||$v if $v; + printf " %s=\"%s\"\n",$p,utf8decode($v)||$v if $v; read_akey($v) if $p eq 'AKEY'; read_skey($v) if $p eq 'SKEY'; } elsif (/^(Param|Exp): (\w+=".+")/) { @@ -209,3 +208,10 @@ sub read_skey { close $skey; } } + + +sub utf8decode { + local $_ = shift; + s/([\xC0-\xDF])([\x80-\xBF])/chr(ord($1)<<6&0xC0|ord($2)&0x3F)/eg; + return $_; +} diff --git a/bin/sexsend b/bin/sexsend index 7340e49..1fedac8 100755 --- a/bin/sexsend +++ b/bin/sexsend @@ -19,7 +19,7 @@ use constant M => 2**20; eval 'use Net::INET6Glue::INET_is_INET6'; -our $version = 20150120; +our $version = 20150615; my %SSL = (SSL_version => 'TLSv1'); my $sigpipe; diff --git a/bin/zz b/bin/zz index 48a5a9f..8195b87 100755 --- a/bin/zz +++ b/bin/zz @@ -7,7 +7,7 @@ ZZ=${ZZ:-$HOME/.zz} -if [ "X$*" = X-h -o "X$*" = X--help ]; then +if [ "$*" = -h -o "$*" = --help ]; then exec cat<>$ZZ fi if [ -t 0 ]; then - if [ x"$1"x = xx ]; then + if [ -z "$1" ]; then exec cat -- $ZZ - elif [ x"$1"x = x..x ]; then + elif [ "$1" = .. ]; then exec cat -- $ZZ~ else test -f $ZZ && mv $ZZ $ZZ~ diff --git a/cgi-bin/fac b/cgi-bin/fac index 1470b83..410eb6b 100755 --- a/cgi-bin/fac +++ b/cgi-bin/fac @@ -1,28 +1,29 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl -Tw # F*EX CGI for administration # -# Author: Andre Hafner +# Original author: Andre Hafner # -use CGI qw(:standard); -use CGI::Carp qw(fatalsToBrowser); +BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 } $| = 1; +$fac = $0; +$fac =~ s:.*/::; + # add fex lib -(our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/; -die "no \$FEXLIB\n" unless -d $FEXLIB; +(our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/ or die "no \$FEXLIB\n"; # import from fex.pp and fex.ph -our ($FEXHOME,$spooldir,$logdir,$docdir,$durl,$mdomain); -our ($bs,$hostname,$keep_default,$recipient_quota,$sender_quota,$autodelete); +our ($FEXHOME,$spooldir,$logdir,$docdir,$akeydir,$durl,$mdomain,$bs,$hostname); +our ($keep_default,$keep_max,$recipient_quota,$sender_quota,$autodelete); our ($admin,$admin_pw,$admin_hosts); our ($sendmail,$bcc); our $error = 'FAC error'; # load common code, local config : $HOME/lib/fex.ph -require "$FEXLIB/fex.pp" or http_die("cannot load $FEXLIB/fex.pp - $!\n"); +require "$FEXLIB/fex.pp"; my @http_auth = (); my $ra = $ENV{REMOTE_ADDR}||0; @@ -38,7 +39,9 @@ chomp($admin_pw = slurp("$admin/@")||''); html_error($error,"no F*EX account for admin $admin\n") unless $admin_pw; # redirect to https if configured -if (0 and open my $x,'/etc/xinetd.d/fexs') { +(undef,$port) = split(':',$ENV{HTTP_HOST}||''); +$port ||= $ENV{PROTO} eq 'https' ? 443 : 80; +if ($port == 80 and open my $x,'/etc/xinetd.d/fexs') { while (<$x>) { if (/^\s*disable\s*=\s*no/) { nvt_print( @@ -53,6 +56,11 @@ if (0 and open my $x,'/etc/xinetd.d/fexs') { close $x; } +our %PARAM; +&parse_parameters; + +$action = $PARAM{"action"}||''; + # authentication &require_akey; @@ -61,16 +69,20 @@ $fup =~ s:/fop:/fup:; my $http_client = $ENV{HTTP_USER_AGENT} || ''; -# here is chosen which files to save with backup function +# files to save with backup function my @backup_files = qw( htdocs/index.html lib/fex.ph lib/fup.pl spool/*@*/@* + spool/*@*/.auto ); # backup goes first -if (defined param("action") and param("action") eq "backup") { &backup } +if ($action eq "backup") { + &backup; + exit; +} http_header('200 OK'); @@ -79,132 +91,136 @@ s:: (logout):; print; my $nav_user = - li("Create new user") . "\n" . - li("Change user auth-ID") . "\n" . - li("Edit user restrictions file") . "\n" . - li("Delete existing user") . "\n" . - li("Manage disk quota") . "\n"; + "
  • Create new user\n". + "
  • Change user auth-ID\n". + "
  • Edit user restrictions file\n". + "
  • Delete existing user\n". + "
  • Manage disk quota\n"; my $nav_log = - li("Get fup.log") . "\n" . - li("Get fop.log") . "\n" . - li("Get error.log") . "\n"; + "
  • Get fup.log\n". + "
  • Get fop.log\n". + "
  • Get error.log\n"; -if (-f 'fexsrv.log') { +if (-f "$logdir/fexsrv.log") { $nav_log = - li("Watch logfile") . "\n" . - li("Get fexsrv.log") . "\n" . - $nav_log; + "
  • Watch logfile\n". + "
  • Get fexsrv.log\n". + $nav_log; } my $nav_backup = - li("Download backup
    (config only)
    ") . "\n" . - li("Restore backup") . "\n"; + "
  • Download backup
    (config only)
    \n". + "
  • Restore backup\n"; my $nav_show = - li("List spooled files") . "\n" . - li("Show quotas (sender/recipient)") . "\n" . - li("Show server config") . "\n" . - li("Show user config") . "\n"; + "
  • List spooled files\n". + "
  • Show quotas (sender/recipient)\n". + "
  • Show server config\n". + "
  • Show user config\n"; my $nav_edit = - li("Edit config") . "\n" . - li("Edit index.html") . "\n"; - -#print table({-border=>"0"},Tr({-valign=>"top"},[td([ul($nav_user), ul($nav_log), ul($nav_backup), ul($nav_other)])])), "\n"; -#print "\n", hr, "\n" ; -print table({-border=>"0"}, - th({},["manage user","show","log files","edit","backup"]), - Tr({-valign=>"top"},[td([ - ul($nav_user), - ul($nav_show), - ul($nav_log), - ul($nav_edit), - ul($nav_backup) -])])), "\n"; -print "
    \n"; + "
  • Edit config\n". + "
  • Edit index.html\n"; + +pq(qq( + '' + ' ' + ' ' + ' ' + ' ' + ' ' + ' ' + ' ' + '
    manage usershowlog fileseditbackup
      $nav_user
    ' + '
      $nav_show
    ' + '
      $nav_log
    ' + '
      $nav_edit
    ' + '
      $nav_backup
    ' + '
    ' + '
    ' +)); my @user_items = &userList; -if (my $action = param("action")) { - if ($action eq "create") { &createUserForm } - elsif ($action eq "change-auth") { &changeAuthForm } - elsif ($action eq "edit") { &editRestrictionsForm } - elsif ($action eq "delete") { &deleteUserForm } - elsif ($action eq "quota") { &changeQuotaForm } - elsif ($action eq "list") { &listFiles } - elsif ($action eq "showquota") { &showQuota } - elsif ($action eq "showconfig") { &showConfig } - elsif ($action eq "userconfig") { &userConfigForm } - elsif ($action eq "watch") { &watchLog } - elsif ($action eq "fexsrv.log") { &getlog("fexsrv.log") } - elsif ($action eq "fup.log") { &getlog("fup.log") } - elsif ($action eq "fop.log") { &getlog("fop.log") } - elsif ($action eq "error.log") { &getlog("error.log") } - elsif ($action eq "editconfig") { &editFile("$FEXLIB/fex.ph") } - elsif ($action eq "editindex") { &editFile("$docdir/index.html") } - elsif ($action eq "backup") { &backup } - elsif ($action eq "restore") { &restoreForm } - else { http_die("STOP TRYING TO CHEAT ME!\n") } -} - -if (defined param("createUser")) { - createUser(param("createUser"), param("authID")); - -} elsif (defined param("changeAuthUser")) { - if (param("changeAuthUser") =~ /^#.*/) { - &changeAuthForm; - } else { - changeUser(param("changeAuthUser"), param("authID")); - } - -} elsif (defined param("showUserConfig")) { - if (param("showUserConfig") =~ /^#.*/) { - &userConfigForm; - } else { - showUserConfig(param("showUserConfig")); - } - -} elsif (defined param("deleteUser")) { - if (param("deleteUser") =~ /^#.*/) { - &deleteUserForm; - } else { - deleteUser(param("deleteUser")); - } -} elsif (defined param("userQuota")) { - if (param("userQuota") =~ /^#.*/) { - &changeQuotaForm; +if ($action eq "create") { &createUserForm } +elsif ($action eq "change-auth") { &changeAuthForm } +elsif ($action eq "edit") { &editRestrictionsForm } +elsif ($action eq "delete") { &deleteUserForm } +elsif ($action eq "quota") { &changeQuotaForm } +elsif ($action eq "list") { &listFiles } +elsif ($action eq "showquota") { &showQuota } +elsif ($action eq "showconfig") { &showConfig } +elsif ($action eq "userconfig") { &userConfigForm } +elsif ($action eq "watch") { &watchLog } +elsif ($action eq "fexsrv.log") { &getlog("fexsrv.log") } +elsif ($action eq "fup.log") { &getlog("fup.log") } +elsif ($action eq "fop.log") { &getlog("fop.log") } +elsif ($action eq "error.log") { &getlog("error.log") } +elsif ($action eq "editconfig") { &editFile("$FEXLIB/fex.ph") } +elsif ($action eq "editindex") { &editFile("$docdir/index.html") } +elsif ($action eq "backup") { &backup } +elsif ($action eq "restore") { &restoreForm } + +if (defined $PARAM{"createUser"}) { + createUser($PARAM{"createUser"}, $PARAM{"authID"}); +} elsif (defined $PARAM{"changeAuthUser"}) { + if ($PARAM{"changeAuthUser"} =~ /^#.*/) { + &changeAuthForm; + } else { + changeUser($PARAM{"changeAuthUser"}, $PARAM{"authID"}); + } +} elsif (defined $PARAM{"showUserConfig"}) { + if ($PARAM{"showUserConfig"} =~ /^#.*/) { + &userConfigForm; + } else { + showUserConfig($PARAM{"showUserConfig"}); + } +} elsif (defined $PARAM{"deleteUser"}) { + if ($PARAM{"deleteUser"} =~ /^#.*/) { + &deleteUserForm; + } else { + deleteUser($PARAM{"deleteUser"}); + } +} elsif (defined $PARAM{"userQuota"}) { + if ($PARAM{"userQuota"} =~ /^#.*/) { + &changeQuotaForm; + } else { + if (defined $PARAM{"default quota"}) { + $user = normalize_user($PARAM{"userQuota"}); + unlink "$user/\@QUOTA"; + print "$user has now default quota:

    \n"; + print "recipient quota: $recipient_quota MB
    \n"; + print "sender quota: $sender_quota MB
    \n"; + &end_html; } else { - if (defined param("remove quota")) { - $user = param("userQuota"); - deleteFiles("$spooldir/$user/\@QUOTA"); - } else { - alterQuota(param("userQuota"), param("recipientQuota"), param("senderQuota")); - } + alterQuota( + $PARAM{"userQuota"}, + $PARAM{"recipientQuota"}, + $PARAM{"senderQuota"} + ); } - -} elsif (defined param("editUser")) { - if (param("editUser") =~ /^#.*/) { - &editRestrictionsForm; + } +} elsif (defined $PARAM{"editUser"}) { + if ($PARAM{"editUser"} =~ /^#.*/) { + &editRestrictionsForm; + } else { + if (defined $PARAM{"delete file"}) { + $user = normalize_user($PARAM{"editUser"}); + unlink "$user/\@ALLOWED_RECIPIENTS"; + print "upload restrictions for $user have been deleted\n"; + &end_html; } else { - if (defined param("delete file")) { - $user = param("editUser"); - deleteFiles("$spooldir/$user/\@ALLOWED_RECIPIENTS"); - } else { - editUser(param("editUser")); - } + editUser($PARAM{"editUser"}); } - -} elsif (defined param("contentBox") && defined param("ar")) { - saveFile(param("contentBox"), param("ar")); - -} elsif (defined param("upload_archive")) { - restore(param("upload_archive")); + } +} elsif ($PARAM{"contentBox"} and $PARAM{"ar"}) { + saveFile($PARAM{"contentBox"},$PARAM{"ar"}); +} elsif ($PARAM{"upload_archive"}) { + restore($PARAM{"upload_archive"}{data}); } -print end_html(); -exit; - +&end_html; ####### # declaration of formular functions @@ -213,102 +229,163 @@ exit; # formular for creating new users # required arguments: - sub createUserForm { - my $nameRow = "\n" . td(["user:", textfield(-size=>80, -name=>"createUser")]); - my $authRow = "\n" . td(["auth-ID:", textfield(-size=>80, -name=>"authID")]); - print "\n", h3("Create new user"); - print "\n", start_form(-name=>"create", -method=>"POST"); - print "\n", table(Tr([$nameRow, $authRow])); - print "\n", submit('create user'), br; - print "\n", end_form; + print h3("Create new user"); + pq(qq( + '

    ' + '' + '' + '' + '' + '' + '' + '' + '
    user
    auth-ID:
    ' + '' + '
    ' + )); + &end_html; } # formular for changing auth-id of an user # required arguments: - sub changeAuthForm { - my $nameRow = "\n" . td(["user:", popup_menu(-name=>"changeAuthUser", -values=>\@user_items)]); - my $authRow = "\n" . td(["new auth-ID:", textfield(-size=>80, -name=>"authID")]); - print "\n", h3("change auth-ID"); - print "\n", start_form(-name=>"change-auth", -method=>"POST"); - print "\n", table(Tr([$nameRow, $authRow])); - print "\n", submit('change'), br; - print "\n", end_form; + my @option = map { "\n" } @user_items; + + print h3("change auth-ID"); + pq(qq( + '
    ' + '' + '' + '' + '' + '' + '' + '' + '
    user:
    new auth-ID:
    ' + '' + '
    ' + )); + &end_html; } # formular choosing user, whose config files shall be shown # required arguments: - sub userConfigForm { - my $nameRow = "\n". td(["user:", popup_menu(-name=>"showUserConfig", -values=>\@user_items)]); - print "\n", h3("Show user config files"); - print "\n", start_form(-name=>"showUserConfig", -method=>"POST"); - print "\n", table(Tr([$nameRow])); - print "\n", submit('show config files'), br; - print "\n", end_form; + my @option = map { "\n" } @user_items; + + print h3("Show user config files"); + pq(qq( + '
    ' + '' + '' + '' + '' + '
    user:
    ' + '' + '
    ' + )); + &end_html; } # formular for choosing user, whose restriction file shall be edited # required arguments: - sub editRestrictionsForm { - my $nameRow = "\n" . td(["user:", popup_menu(-name=>"editUser", -values=>\@user_items)]); - print "\n", h3("Edit user restriction file"); - print "\n", start_form(-name=>"edit", -method=>"POST"); - print "\n", table(Tr([$nameRow])); - print "\n", submit('edit file'); - print "\n", submit('delete file'), br; - print "\n", end_form; + my @option = map { "\n" } @user_items; + + print h3("Edit user restriction file"); + pq(qq( + '
    ' + '' + '' + '' + '' + '
    user:
    ' + '' + '' + '
    ' + )); + &end_html; } # formular for choosing user, who shall be removed # required arguments: - sub deleteUserForm { - my $nameRow = "\n". td(["user:", popup_menu(-name=>"deleteUser", -values=>\@user_items)]); - print "\n", h3("Delete existing user"); - print "\n", start_form(-name=>"deleteUser", -method=>"POST"); - print "\n", table(Tr([$nameRow])); - print "\n", submit('delete user'), br; + my @option = map { "\n" } @user_items; - print "\n", end_form; + print h3("Delete existing user"); + pq(qq( + '
    ' + '' + '' + '' + '' + '
    user:
    ' + '' + '
    ' + )); + &end_html; } # formular for changing an user's quota file # required arguments: - sub changeQuotaForm { - my ($rquota,$squota) = ''; - $rquota = param("rquota") if defined param("rquota"); - $squota = param("squota") if defined param("squota"); - my $dropdownMenu; - if (defined param("user")) { - $dropdownMenu = "\n"; + my $user; + my @option; + my $rquota = ''; + my $squota = ''; + + if ($user = $PARAM{"user"}) { + + $user = normalize_user($user); + $rquota = $1 if ($PARAM{"rquota"}||'') =~ /^(\d+)$/; + $squota = $1 if ($PARAM{"squota"}||'') =~ /^(\d+)$/; + } + + foreach (@user_items) { + if ($user and $user eq $_) { + push @option,"\n"; } else { - $dropdownMenu = popup_menu(-name=>"userQuota", -values=>\@user_items); + push @option,"\n"; } - my $nameRow = "\n" . td(["user:", $dropdownMenu]); - my $recipientRow = "\n" . td(["new quota for recipient:", textfield(-size=>20, -name=>"recipientQuota", -value=>$rquota). " MB (optional)"]); - my $senderRow = "\n" . td (["new quota for sender:", textfield(-size=>20, -name=>"senderQuota", -value=>$squota). " MB (optional)"]); - print "\n", h3("Manage disk quota"); - print "\n", start_form(-name=>"manageQuota", -method=>"POST"); - print "\n", table(Tr([$nameRow, $recipientRow, $senderRow])); - print "\n", submit('change quota'); - print "\n", submit('remove quota'), br; - print "\n", end_form; + } + + print h3("Manage disk quota"); + pq(qq( + '
    ' + '' + '' + '' + '' + '' + '' + '' + '' + '' + '' + '' + '' + '
    user:
    new quota for recipient:' + ' MB (optional)
    new quota for sender:' + ' MB (optional)
    ' + '' + '' + '
    ' + )); + &end_html; } # formular for choosing backup file to restore # required arguments: - sub restoreForm { - print h2("restore config"); - print "please specify the backup-archive you want to restore:"; - print "\n", start_form(-name=>"restoreFile", -method=>"POST"); - print "\n", filefield(-name=>"upload_archive", -size=>"80"), br; - print "\n", submit('restore'); - print "\n", end_form; + print h2("restore config"); + pq(qq( + 'Specify the backup-archive you want to restore:
    ' + '
    ' + '
    ' + '' + '
    ' + )); + &end_html; } @@ -319,417 +396,453 @@ sub restoreForm { # function for creating new users # required arguments: username, auth-id sub createUser { - my ($user,$id) = @_; - my $idf; - - $id or http_die("not enough arguments in createUser"); - - $user = lc $user; - $user =~ s:/::g; - $user =~ s:^[.@]+::; - $user =~ s:@+$::; - - if ($user !~ /@/) { - if ($mdomain) { - $user .= '@'.$mdomain; - } else { - error("Missing domain part in user address"); - } - } + my ($user,$id) = @_; + my $idf; - unless (-d "$spooldir/$user") { - mkdir "$spooldir/$user",0755 - or http_die("cannot mkdir $spooldir/$user - $!\n"); - } + http_die("not enough arguments in createUser") unless $id; - $idf = "$spooldir/$user/@"; + $user = normalize_user($user); - if (-f $idf) { - error("There is already an user $user!"); - } + unless (-d "$user") { + mkdir "$user",0755 or http_die("cannot mkdir $user - $!"); + } + + $idf = "$user/@"; + + if (-f $idf) { + html_error($error,"There is already an user $user!"); + } - open $idf,'>',$idf or http_die("cannot write $idf - $!\n"); - print {$idf} $id,"\n"; - close $idf or http_die("cannot write $idf - $!\n"); - print "\n"; - printf "%s?from=%s&ID=%s
    \n",$fup,$user,$id; - printf "%s/%s

    \n",$fup,b64("from=$user&id=$id"); - print "\n"; - notifyUser($user,$id); - print "An information e-mail to $user has been sent.\n"; + open $idf,'>',$idf or http_die("cannot write $idf - $!"); + print {$idf} $id,"\n"; + close $idf or http_die("cannot write $idf - $!"); + print "\n"; + printf "%s?from=%s&ID=%s
    \n",$fup,$user,$id; + printf "%s/%s

    \n",$fup,b64("from=$user&id=$id"); + print "\n"; + notifyUser($user,$id); + print "An information e-mail to $user has been sent.\n"; + &end_html; } # function for changing an user's auth-ID # required arguments: username, auth-id sub changeUser { - my ($user,$id) = @_; - defined($id) or http_die("not enough arguments in changeUser.\n"); - - $user .= '@'.$mdomain if $mdomain and $user !~ /@/; - my $idf = "$spooldir/$user/@"; - print "\n"; - print "$idf

    "; - - open $idf,'>',$idf or http_die("cannot write $idf - $!\n"); - print {$idf} $id,"\n"; - close $idf or http_die("cannot write $idf - $!\n"); - printf "%s?from=%s&ID=%s
    \n",$fup,$user,$id; - printf "%s/%s\n",$fup,b64("from=$user&id=$id"); - print "

    \n"; - notifyUser($user,$id,"change-auth"); - print "An information e-mail to $user has been sent.\n"; + my ($user,$id) = @_; + + http_die("not enough arguments in changeUser") unless $id; + + $id = despace($id); + $user = normalize_user($user); + my $idf = "$user/@"; + print "\n"; + print "$idf

    "; + + open $idf,'>',$idf or http_die("cannot write $idf - $!"); + print {$idf} $id,"\n"; + close $idf or http_die("cannot write $idf - $!"); + printf "%s?from=%s&ID=%s
    \n",$fup,$user,$id; + printf "%s/%s\n",$fup,b64("from=$user&id=$id"); + print "

    \n"; + notifyUser($user,$id,"change-auth"); + print "An information e-mail to $user has been sent.\n"; + &end_html; } # function for showing an user's config files # required arguments: username sub showUserConfig { - http_die("not enough arguments in showUserConfig!\n") unless (my $user = $_[0]); + my $user = shift; + + http_die("not enough arguments in showUserConfig!") unless $user; + $user = normalize_user($user); - chdir "$spooldir/$user" or http_die("could not change directory $spooldir/$user - $!"); - print h2("Config files of $user"); - - foreach my $file (glob('.auto @* @GROUP/*')) { - if (-f $file and not -l $file and $file !~ /.*~$/) { - print h3($file), "\n"; - open $file,'<',$file or http_die("cannot open $file - $!"); - # print "
    \n"; - dumpfile($file); - # print "
    \n"; - close $file; - } + chdir "$user" or http_die("could not change directory $user - $!"); + print h2("Config files of $user"); + + foreach my $file (glob('.auto @* @GROUP/*')) { + if (-f $file and not -l $file and $file !~ /.*~$/) { + print h3($file), "\n"; + open $file,'<',$file or http_die("cannot open $file - $!"); + # print "
    \n"; + dumpfile($file); + # print "
    \n"; + close $file; } + } + &end_html; } # function for editing an user's recipient/sender restrictions # required arguments: username sub editUser { - http_die("not enough arguments in editUser.\n") unless (my $user = $_[0]); - my @content; - http_die("no user $user") unless -d "$spooldir/$user"; - my $ar = "$spooldir/$user/\@ALLOWED_RECIPIENTS"; - unless (-f $ar) { - print "yeah!"; - open F,">$ar" or http_die("cannot open $ar - $!"); - print F<',$ar or http_die("cannot open $ar - $!"); + print {$ar}<<'EOD'; # Restrict allowed recipients. Only those listed here are allowed. # Make this file COMPLETLY empty if you want to disable the restriction. # An allowed recipient is an e-mail address, you can use * as wildcard. -# Example: *\@flupp.org +# Example: *@flupp.org EOD - close F; - } - open my $file,'<',$ar or http_die("cannot open $ar - $!"); - while (<$file>) { - push @content, $_; - } - close $file or http_die("cannot write $file - $!\n"); - print "\nedit file:", br; - print "\n", start_form(-name=>"editRestrictions", -method=>"POST"); - print "\n", textarea(-name=>'contentBox', -default=>join('',@content), -rows=>10, -columns=>80), br; - print "\n", hidden(-name=>'ar', -default=>"$ar",); - print "\n", submit('save changes'); - print "\n", end_form; + close $ar; + } + $content = dehtml(slurp($ar)); + pq(qq( + 'Edit restrictions file for user $user :
    ' + '

    ' + '
    ' + '' + '' + '
    ' + )); + &end_html; } # function for deleting files # required arguments: list of Files sub deleteFiles { - http_die("not enough arguments in deleteFiles.\n") unless (my @files = @_); + http_die("not enough arguments in deleteFiles") unless (my @files = @_); - foreach (@files) { - if (-e $_) { - if (unlink $_) { - print "file has been deleted: $_\n", br; - } else { - print "file could not be deleted: $_ - $!\n", br; - } - } else { - print "file does not exists: $_\n", br; - } + foreach (@files) { + if (-e) { + if (unlink $_) { + print "file has been deleted: $_
    \n"; + } else { + print "file could not be deleted: $_ - $!
    \n"; + } + } else { + print "file does not exists: $_
    \n"; } + } + &end_html; } # function for saving a single file # required arguments: content, location sub saveFile { - http_die("not enough arguments in saveFile.\n") unless (my ($rf,$ar) = @_); - - if ($ar eq "$FEXLIB/fex.ph") { - open my $conf,">${ar}_new" or http_die("cannot open ${ar}_new - $!"); - print {$conf} $rf; - close $conf or http_die("cannot write $conf - $!\n");; - my $status = `perl -c $FEXLIB/fex.ph_new 2>&1`; - if ($status =~ /syntax OK/ ) { - unlink "${ar}_new"; - } else { - pq(qq( - 'No valid syntax in configuration file:' - '

    ' - '

    $status
    ' - )); - &editFile("$FEXLIB/fex.ph_new"); - exit; - } - } - open my $file,">$ar" or http_die("cannot open $ar - $!"); - print {$file} $rf; - close $file or http_die("cannot write $file - $!\n");; - print "The following data has been saved:\n

    \n"; - open $file,'<',$ar or http_die("cannot open $ar - $!"); - if ($ar =~ /\.html$/) { - print while <$file>; + my ($rf,$ar) = @_; + my $new; + + http_die("not enough arguments in saveFile") unless $ar; + + if ($ar eq 'index.html') { + $ar = "$docdir/index.html" + } elsif ($ar eq 'fex.ph') { + $ar = "$FEXLIB/fex.ph" + } elsif ($ar =~ m'^([^/]+/\@ALLOWED_RECIPIENTS)$') { + $ar = $1; + } else { + http_die("unknown file $ar") + } + + $new = $ar.'_new'; + if ($ar =~ /fex.ph$/) { + open $new,'>',$new or http_die("cannot open ${ar}_new - $!"); + print {$new} $rf; + close $new or http_die("cannot write $new - $!");; + my $status = dehtml(`perl -c $FEXLIB/fex.ph_new 2>&1`); + if ($status =~ /syntax OK/ ) { + rename $ar,"$ar~"; + rename $new,$ar; + http_die("cannot write $ar~ - $!") if $?; } else { - print "

    \n";
    -	print while <$file>;
    +      rename "$ar~",$ar;
    +      pq(qq(
    +        'No valid syntax in configuration file:'
    +        '

    $status

    ' + 'back' + )); + &end_html; } - close $file or http_die("cannot write $file - $!\n");; + } else { + system qw'cp -a',$ar,"$ar~"; + } + open $ar,'>',$ar or http_die("cannot write $ar - $!"); + print {$ar} $rf; + close $ar or http_die("cannot write $ar - $!");; + print "$ar has been saved\n"; + &end_html; } # function for deleting existing user # required arguments: username sub deleteUser { - http_die("not enough arguments in createUser.\n") unless (my $user = $_[0]); + my $user = shift; + + http_die("not enough arguments in deleteUser") unless $user; + + $user = normalize_user($user); - $idf = "$spooldir/$user/\@"; - http_die("no such user $user\n") unless -f $idf; - unlink $idf or http_die("cannot remove $idf - $!\n"); - unlink "$spooldir/$user/\@ALLOWED_RECIPIENTS"; - print "$user deleted\n"; + $idf = "$user/\@"; + http_die("no such user $user") unless -f $idf; + unlink $idf or http_die("cannot remove $idf - $!"); + unlink "$user/\@ALLOWED_RECIPIENTS"; + unlink "$user/\@SUBUSER"; + rmrf("$user/\@GROUP"); + print "$user deleted\n"; + &end_html; } # function for saving quota information for one single user # required arguments: username, recipient-quota, sender-quota sub alterQuota { - http_die("not enough arguments in createUser.\n") unless (my ($user,$rq,$sq) = @_); - - $user .= '@'.$mdomain if $mdomain and $user !~ /@/; - unless (-d "$spooldir/$user") { - http_die("$user is not a regular F*EX user\n"); - } + my ($user,$rq,$sq) = @_; + my ($rquota,$squota); + my $qf; - $rquota = $squota = ''; - $qf = "$spooldir/$user/\@QUOTA"; - if (open $qf,'<',$qf) { - while (<$qf>) { - s/#.*//; - $rquota = $1 if /recipient.*?(\d+)/i; - $squota = $1 if /sender.*?(\d+)/i; - } - close $qf or http_die("cannot write $qf - $!\n"); - } - - open $qf,'>',$qf or http_die("cannot open $qf - $!\n"); - if(defined($rq) && $rq ne "") { - $rquota = $1 if $rq =~ /(\d+)/i; + $user = normalize_user($user); + http_die("$user is not a F*EX user") unless -d $user; + + $rquota = $squota = ''; + $qf = "$user/\@QUOTA"; + if (open $qf,$qf) { + while (<$qf>) { + s/#.*//; + $rquota = $1 if /recipient.*?(\d+)/i; + $squota = $1 if /sender.*?(\d+)/i; } - if(defined($sq) && $sq ne "") { - $squota = $1 if $sq =~ /(\d+)/i; - } - print {$qf} "recipient:$rquota\n" if $rquota =~ /\d/; - print {$qf} "sender:$squota\n" if $squota =~ /\d/; - close $qf or http_die("cannot write $qf - $!\n"); - - $rquota = $recipient_quota if $rquota !~ /\d/; - $squota = $sender_quota if $squota !~ /\d/; - print h3("New quotas for $user"); - print "recipient quota: $rquota MB\n", br; - print "sender quota: $squota MB\n", br; + close $qf; + } + + $rquota = $1 if $rq and $rq =~ /(\d+)/; + $squota = $1 if $sq and $sq =~ /(\d+)/; + open $qf,'>',$qf or http_die("cannot write $qf - $!"); + print {$qf} "recipient:$rquota\n" if $rquota; + print {$qf} "sender:$squota\n" if $squota; + close $qf or http_die("cannot write $qf - $!"); + + $rquota = $recipient_quota unless $rquota; + $squota = $sender_quota unless $squota; + print h3("New quotas for $user"); + print "recipient quota: $rquota MB
    \n"; + print "sender quota: $squota MB
    \n"; + &end_html; } # function for listing f*exed files # required arguments: - sub listFiles { - print h3("List current files"),"\n"; - my ($file,$dkey); - chdir $spooldir or http_die("$spooldir - $!\n"); - print "\n"; - foreach $file (glob "*/*/*") { - if (-s "$file/data" and $dkey = readlink("$file/dkey") and -l ".dkeys/$dkey") { - ($to,$from,$file) = split "/",$file; - $file = html_quote($file); - print "$from --> $to : $durl/$dkey/$file
    \n"; - } + print h3("List current files"); + my ($file,$dkey); + print "

    \n";
    +  foreach $recipient (glob "*@*") {
    +    next if -l $recipient;
    +    foreach $file (glob "$recipient/*/*") {
    +      if (-s "$file/data" and  $dkey = readlink("$file/dkey") and -l ".dkeys/$dkey") {
    +        ($to,$from,$file) = split "/",$file;
    +        $file = html_quote($file);
    +        print "$from → $to : $durl/$dkey/$file\n";
    +      }
         }
    -    print "\n";
    +  }
    +  print "
    \n"; + &end_html; } # function for watching the fex-logfile # required arguments: - sub watchLog { - if (-f 'fexsrv.log') { + if (-f "$logdir/fexsrv.log") { print h2("polling fexsrv.log"),"\n"; open my $log,"$FEXHOME/bin/logwatch|" - or http_die("cannot run $FEXHOME/bin/logwatch - $!\n"); + or http_die("cannot run $FEXHOME/bin/logwatch - $!"); dumpfile($log); } else { - print h2("no fexsrv.log"),"\n"; + print h2("no fexsrv.log"); } + &end_html; } # function for showing logfiles # required arguments: logfile-name sub getlog { - my $log = shift or http_die("not enough arguments in getLog"); - - print h2("show $log"),"\n"; - if (open $log,"$logdir/$log") { - dumpfile($log); - close $log; - } else { - http_die("cannot open $logdir/$log - $!\n"); - } + my $log = shift or http_die("not enough arguments in getLog"); + + print h2("show $log"); + if (open $log,"$logdir/$log") { + dumpfile($log); + close $log; + } else { + http_die("cannot open $logdir/$log - $!"); + } + &end_html; } # function for creating a new backup file # required arguments: - sub backup { - my @d = localtime time; - my $date = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); - my $backup = "backup/config-$date.tar"; - my $http_client = $ENV{HTTP_USER_AGENT} || ''; - my $size; - - my $home = $FEXHOME; - $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/; + my @d = localtime time; + my $date = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); + my $backup = "backup/config-$date.tar"; + my $http_client = $ENV{HTTP_USER_AGENT} || ''; + my $size; + + my $home = $FEXHOME; + $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/; - chdir $home or http_die("$home - $!\n"); - - unless (-d "backup") { - mkdir "backup",0700 or http_die("cannot mkdir backup - $!\n"); - } - - system "tar -cf $backup @backup_files 2>/dev/null"; - - $size = -s $backup or http_die("backup file empty\n"); - - open $backup,'<',$backup or http_die("cannot open $backup - $!\n"); - - nvt_print( - 'HTTP/1.1 200 OK', - "Content-Length: $size", - "Content-Type: application/octet-stream; filename=fex-backup-$date.tar", - "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"", - "", - ); - - while (read($backup,my $b,$bs)) { - print $b or last; - } - - exit; + chdir $home or http_die("$home - $!"); + + unless (-d "backup") { + mkdir "backup",0700 or http_die("cannot mkdir backup - $!"); + } + + system "tar -cf $backup @backup_files 2>/dev/null"; + + $size = -s $backup or http_die("backup file empty"); + + open $backup,'<',$backup or http_die("cannot open $backup - $!"); + + nvt_print( + 'HTTP/1.1 200 OK', + "Content-Length: $size", + "Content-Type: application/octet-stream; filename=fex-backup-$date.tar", + "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"", + "", + ); + + while (read($backup,my $b,$bs)) { + print $b or last; + } + + exit; } # function for restoring an old configuration file # required arguments: uploaded archive sub restore { - http_die("not enough arguments in restore!\n") unless (my $archive_file = $_[0]); - my $restore = "backup.tar"; - - my $home = $FEXHOME; - $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/; - - chdir $home or http_die("$home - $!\n"); - - open $restore,'>',$restore or http_die("cannot open $restore - $!"); - - my $data; - while(read $archive_file,$data,$bs) { - print {$restore} $data; - } - close $restore or http_die("cannot write $restore - $!"); - if (-s $restore) { - print "file upload successful, saving actual config in $home/backup/failsave.tar\n", br; - system "tar -cf $home/backup/failsave.tar @backup_files 2>/dev/null"; - print "starting restore:\n

    \n";
    -        system "tar -xvf $restore";
    -        unlink $restore;
    -    } else {
    -	http_die("upload error - no file data received\n");
    -    }
    +  my $archive_file = shift or http_die("not enough arguments in restore!");
    +  my $restore = "backup.tar";
    +  my $home = $FEXHOME;
    +
    +  $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
    +
    +  chdir $home or http_die("$home - $!");
    +  mkdir 'backup';
    +
    +  open $restore,'>',$restore or http_die("cannot open $restore - $!");
    +  print {$restore} $archive_file;
    +  close $restore or http_die("cannot write $restore - $!");
    +  if (-s $restore) {
    +    print "file upload successful
    \n"; + print "saving actual config in $home/backup/config.tar
    \n"; + print "
    \n";
    +    system "tar -cf backup/config.tar @backup_files";
    +    print "
    \n"; + print "starting restore:\n

    \n"; + print "

    \n";
    +    system "tar -xvf $restore";
    +    unlink $restore;
    +    &end_html;
    +  } else {
    +    http_die("upload error - no file data received");
    +  }
     }
     
     # function for editing a text-file
     # required arguments: filepath, filename
     sub editFile {
    -    my $ar = shift;
    -    my $file;
    -    local $/;
    +  my $ar = shift;
    +  my $file;
       
    -    open $ar,'<',$ar or http_die("cannot open $ar - $!");
    -    $file = <$ar>;
    -    close $ar;
    +  $file = dehtml(slurp($ar));
    +  
    +  $ar =~ s:.*/::;
     
    -    print start_form(-name=>"editFile", -method=>"POST"),"\n";
    -    print textarea(-name=>'contentBox', -default=>$file, -rows=>26, -columns=>80), br,"\n";
    -    print hidden(-name=>'ar', -default=>"$ar"),"\n";
    -    print submit('save changes'),"\n";
    -    print end_form(),"\n";
    +  print h2("edit $ar");
    +
    +  pq(qq(
    +    '
    ' + '
    ' + '' + '' + '
    ' + )); + &end_html; } # function for showing all users' quotas # required arguments: - sub showQuota { - my @table_content; - my $table_head; - - print h2("Show quotas (domain sorted, values in MB)"); - foreach (@user_items) { - if (s/###\s*//g) { - $table_head = th({}, ["\@$_","sender","sender (used)","recipient","recipient (used)"]); - if (@table_content) { - print table({-border=>1},Tr([@table_content])), "\n

    \n"; - @table_content = ''; - } - push @table_content, $table_head; - } else { - my $rquota = $recipient_quota; - my $squota = $sender_quota; - my $rquota_used = 0; - my $squota_used = 0; - my $user = $_; - ($squota,$squota_used) = check_sender_quota($user); - ($rquota,$rquota_used) = check_recipient_quota($user); - s/\@.*//; - push @table_content, - "$_". - "$squota". - "$squota_used". - "$rquota". - "$rquota_used"; - } + + print h2("Show quotas (domain sorted, values in MB)"); + print ""; + foreach (@user_items) { + if (/\#\#\#\s(\S+)/) { + print ""; + print ""; + print ""; + print ""; + print ""; + print ""; + print "\n"; +# $table = $_; + } else { + my $rquota = $recipient_quota; + my $squota = $sender_quota; + my $rquota_used = 0; + my $squota_used = 0; + my $user = $_; + ($squota,$squota_used) = check_sender_quota($user); + ($rquota,$rquota_used) = check_recipient_quota($user); + my $action = "quota&user=$user&rquota=$rquota&squota=$squota"; + s/\@.*//; + print ""; + print ""; + print ""; + print ""; + print ""; + print ""; + print "\n"; } - print table({-border=>1},Tr([@table_content])), "\n"; + } + print "
    \@$1sendersender (used)recipientrecipient (used)
    $_$squota$squota_used$rquota$rquota_used
    \n"; + &end_html; + } # function for showing fex-server configuration # required arguments: - sub showConfig { - print h3("Show config"); - print table({},Tr([ - td(["spooldir:", $spooldir ]), - td(["logdir:", $logdir ]), - td(["docdir:", $docdir ]), - td(["durl:", $durl ]), - td(["mdomain:", $mdomain||'' ]), - td(["autodelete:", $autodelete ]), - td(["keep:", $keep_default ]), - td(["recipient_quota:", $recipient_quota]), - td(["sender_quota:", $sender_quota ]), - td(["admin:", $admin ]) - ])); + print h3("Show config"); + print "\n"; + printf "\n",$spooldir; + printf "\n",$logdir; + printf "\n",$docdir; + printf "\n",$durl; + printf "\n",$mdomain||''; + printf "\n",$autodelete; + printf "\n",$keep_default; + printf "\n",$keep_max; + printf "\n",$recipient_quota; + printf "\n",$sender_quota; + printf "\n",$admin; + print "
    spooldir:%s
    logdir:%s
    docdir:%s
    durl:%s
    mdomain:%s
    autodelete:%s
    keep:%s
    keep_max:%s
    recipient_quota:%s
    sender_quota:%s
    admin:%s
    \n"; + &end_html; } # require authentification sub require_akey { my $id; my $rid; - my $action; - $action = param("action"); - if ($action and $action eq 'logout') { + if ($action eq 'logout') { + if (($ENV{HTTP_COOKIE}||'') =~ /akey=(\w+)/) { + unlink "$akeydir/$1"; + } nvt_print( "HTTP/1.1 301 Moved Permanently", - "Location: /fac", + "Location: /$fac", 'Content-Length: 0', "Set-Cookie: akey=; Max-Age=0; Discard", '' @@ -740,7 +853,7 @@ sub require_akey { $rid = slurp("$admin/@") or html_error($error,"no F*EX account for $admin"); chomp $rid; - $id = param("id"); + $id = $PARAM{"id"}; if ($id) { # correct auth-ID? @@ -773,14 +886,12 @@ sub require_akey { } pq(qq( - '

    ' + '' ' auth-ID for $admin:' ' ' '
    ' )); - exit; + &end_html; } @@ -804,81 +915,91 @@ sub require_auth { } } + # function for sending notification mails to an user # required arguments: username, auth-id, message-type sub notifyUser { - http_die("not enough arguments in createUser.\n") unless (my ($user,$id) = @_); - my $type = $_[2]; - my $message = 'A F*EX account has been created for you. Use'; + my ($user,$id,$type) = @_; + my $url = $durl; + my $message = 'A F*EX account has been created for you. Use'; - if (defined($type) and $type eq "change-auth") { - $message = 'New auth-ID for your F*EX account has been set. Use' - } + http_die("not enough arguments in createUser") unless $id; + if ($type and $type eq "change-auth") { + $message = 'New auth-ID for your F*EX account has been set. Use' + } - $user .= '@'.$mdomain if $mdomain and $user !~ /@/; - open my $mail,'|-',$sendmail,'-f',$admin,$user,$bcc - or http_die("cannot start sendmail - $!\n"); - pq($mail,qq( - 'From: $admin' - 'To: $user' - 'Subject: your F*EX account on $hostname' - 'X-Mailer: F*EX' - '' - '$message' - '' - '$ENV{PROTO}://$ENV{HTTP_HOST}/fup?from=$user' - 'auth-ID: $id' - '' - 'See http://$ENV{HTTP_HOST}/index.html for more information about F*EX.' - '' - 'Questions? ==> F*EX admin: $admin' - )); - close $mail - or http_die("cannot send notification e-mail (sendmail error $!)\n"); + $user = normalize_user($user); + open my $mail,'|-',$sendmail,'-f',$admin,$user,$bcc + or http_die("cannot start sendmail - $!"); + $url =~ s:/fop::; + pq($mail,qq( + 'From: $admin' + 'To: $user' + 'Subject: your F*EX account on $hostname' + 'X-Mailer: F*EX' + '' + '$message' + '' + '$url/fup?from=$user' + 'auth-ID: $id' + '' + 'See $url/index.html for more information about F*EX.' + '' + 'Questions? ==> F*EX admin: $admin' + )); + close $mail + or http_die("cannot send notification e-mail (sendmail error $!)"); } + # sort key is the (inverse) domain # required arguments: list of usernames (e-mail addresses) sub domainsort { -# http_die("not enough arguments in domainsort.\n") unless (my @d = @_); - my @d = @_; - local $_; - - foreach (@d) { - s/ //g; - s/^/ /; - s/\./,/ while /\..*@/; - s/@/@./; - $_ = join('.',reverse(split /\./)); - } - - @d = sort { lc $a cmp lc $b } @d; - - foreach (@d) { - $_ = join('.',reverse(split /\./)); - s/,/./g; - s/@\./@/; - } - - return @d; +# http_die("not enough arguments in domainsort") unless (my @d = @_); + my @d = @_; + local $_; + + foreach (@d) { + s/\s//g; + s/\./,/ while /\..*@/; + s/@/@./; + $_ = join('.',reverse(split /\./)); + } + + @d = sort { lc $a cmp lc $b } @d; + + foreach (@d) { + $_ = join('.',reverse(split /\./)); + s/,/./g; + s/@\./@/; + } + + return @d; } # function for creating a sorted list of all users # required arguments: - sub userList { - my @u; - my $d = ''; - - foreach (domainsort(grep { s:/@:: } glob('*@*/@'))) { - s/ //g; - /@(.+)/; - if ($1 ne $d) { - push @u,"### $1 ###"; - } - push @u,$_; - $d = $1; + my (@u,@list); + my $domain = ''; + my $u; + + foreach $u (glob('*@*')) { + next if -l $u; + push @u,$u if -f "$u/@"; + } + + foreach (domainsort(@u)) { + if (/@(.+)/) { + if ($1 ne $domain) { + push @list,"### $1 ###"; + } + push @list,$_; + $domain = $1; } - return @u; + } + + return @list; } @@ -886,17 +1007,34 @@ sub dumpfile { my $file = shift; print "
    \n";
    -  while (<$file>) {
    -    s/&/&/g;
    -    s/) { print dehtml($_) }
       print "\n
    \n"; } -sub error { - print join("\n",@_),"\n"; - print end_html(); - exit; +sub h2 { + local $_ = shift; + chomp; + return "

    $_

    \n"; +} + + +sub h3 { + local $_ = shift; + chomp; + return "

    $_

    \n"; +} + + +sub end_html { + print "\n"; + exit; +} + + +sub dehtml { + local $_ = shift; + s/&/&/g; + s/ # -use CGI qw(:standard); -use CGI::Carp qw(fatalsToBrowser); +BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 } + use Fcntl qw(:flock); use Digest::MD5 qw(md5_hex); -$CGI::LIST_CONTEXT_WARN = 0; -$CGI::LIST_CONTEXT_WARN = 0; - # add fex lib ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/; die "$0: no $FEXLIB\n" unless -d $FEXLIB; @@ -31,9 +28,11 @@ $akeydir = "$spooldir/.akeys"; $user = $id = ''; # look for CGI parameters -foreach my $v (param) { - my $vv = param($v); - debuglog("Param: $v=\"$vv\""); +our %PARAM; +&parse_parameters; +foreach my $v (keys %PARAM) { + my $vv = $PARAM{$v}; + # debuglog("Param: $v=\"$vv\""); if ($v =~ /^akey$/i and $vv =~ /^(\w+)$/) { $akey = $1; } elsif ($v =~ /^(from|user)$/i) { diff --git a/cgi-bin/fop b/cgi-bin/fop index 4370fb6..949f084 100755 --- a/cgi-bin/fop +++ b/cgi-bin/fop @@ -5,8 +5,8 @@ # Author: Ulli Horlacher # -use CGI qw':standard'; -use CGI::Carp qw'fatalsToBrowser'; +BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 } + use Fcntl qw':flock :seek'; use Cwd qw'abs_path'; use File::Basename; @@ -20,8 +20,8 @@ die "$0: no $FEXLIB\n" unless -d $FEXLIB; our $error = 'F*EX download ERROR'; our $head = "$ENV{SERVER_NAME} F*EX download"; # import from fex.pp -our ($spooldir,$tmpdir,$logdir,$skeydir,$dkeydir,$durl); -our ($bs,$fop_auth,$timeout,$keep_default); +our ($spooldir,$tmpdir,@logdir,$skeydir,$dkeydir,$durl); +our ($bs,$fop_auth,$timeout,$keep_default,$nowarning); our ($limited_download,$admin,$akey,$adlm,$amdl); our (@file_link_dirs); @@ -46,7 +46,7 @@ if ($0 !~ m{/locale/.*/fop} and my $lang = $ENV{HTTP_ACCEPT_LANGUAGE}) { } } -my $log = "$logdir/fop.log"; +my $log = 'fop.log'; chdir $spooldir or die "$spooldir - $!\n"; @@ -397,11 +397,13 @@ if ($qs = $ENV{QUERY_STRING}) { $filename,$ENV{REMOTE_ADDR},isodate(time); close $log; } - if (open $log,'>>',$log) { - printf {$log} - "%s [%s_%s] %s %s deleted\n", - isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file); - close $log; + foreach my $logdir (@logdir) { + my $msg = sprintf "%s [%s_%s] %s %s deleted\n", + isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file); + if (open $log,'>>',"$logdir/$log") { + print {$log} $msg; + close $log; + } } http_header('200 OK',"X-File: $file"); print html_header($head), @@ -420,11 +422,13 @@ if ($qs = $ENV{QUERY_STRING}) { if (@anonymous_upload and ipin($ra,@anonymous_upload)) { unlink "$dkeydir/$dkey" if $dkey; if (rmrf($file)) { - if (open $log,'>>',$log) { - printf {$log} - "%s [%s_%s] %s %s purged\n", - isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file); - close $log; + foreach my $logdir (@logdir) { + my $msg = sprintf "%s [%s_%s] %s %s purged\n", + isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file); + if (open $log,'>>',"$logdir/$log") { + print {$log} $msg; + close $log; + } } http_header('200 OK',"X-File: $file"); print html_header($head), @@ -553,7 +557,7 @@ if (-f $data) { chomp; if ($ra) { # allow downloads from same ip - $_ = '' if $ra eq $_; + $_ = '' if /\Q$ra/; # allow downloads from sender ip $_ = '' if (readlink("$file/ip")||'') eq $ra; } @@ -746,7 +750,7 @@ sub sendfile { # another stupid IE bug-workaround # http://drupal.org/node/163445 # http://support.microsoft.com/kb/323308 - if ($http_client =~ /MSIE/) { + if ($http_client =~ /MSIE/ and not $nowarning) { # $type = 'application/x-msdownload'; if ($ignorewarning) { $type .= "; filename=$filename"; diff --git a/cgi-bin/fuc b/cgi-bin/fuc index 864a3de..c18aa45 100755 --- a/cgi-bin/fuc +++ b/cgi-bin/fuc @@ -6,14 +6,11 @@ # Author: Ulli Horlacher # -use CGI qw(:standard); -use CGI::Carp qw(fatalsToBrowser); +BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 } + use Fcntl qw(:flock); use Digest::MD5 qw(md5_hex); -$CGI::LIST_CONTEXT_WARN = 0; -$CGI::LIST_CONTEXT_WARN = 0; - # add fex lib ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/; die "$0: no $FEXLIB\n" unless -d $FEXLIB; @@ -49,10 +46,12 @@ if ($qs) { if ($qs =~ /ab=load/) { $ab = 'load' } } -# look for CGI POST parameters -foreach my $v (param) { - my $vv = param($v); - debuglog("Param: $v=\"$vv\""); +# look for CGI parameters +our %PARAM; +&parse_parameters; +foreach my $v (keys %PARAM) { + my $vv = $PARAM{$v}; + # debuglog("Param: $v=\"$vv\""); if ($v =~ /^akey$/i) { $akey = $1 if $vv =~ /^(\w+)$/; next; @@ -65,7 +64,7 @@ foreach my $v (param) { $v =~ /^notification$/i ? $notification = checkchars('parameter',$vv): $v =~ /^disclaimer$/i ? $disclaimer = $vv: $v =~ /^encryption$/i ? $encryption = checkchars('parameter',$vv): - $v =~ /^pubkey$/i ? $pubkey = $vv: + $v =~ /^pubkey$/i ? $pubkey = $PARAM{$v}{data}: $v =~ /^reminder$/i ? $reminder = checkchars('parameter',$vv): $v =~ /^mime$/i ? $mime = checkchars('parameter',$vv): $v =~ /^comment$/i ? $comment = decode_utf8(normalize($vv)): @@ -79,7 +78,10 @@ foreach my $v (param) { $ESAC; } -$group = lc $group if $group and $group ne 'NEW'; +if ($group and $group ne 'NEW') { + $group = lc $group; + $group =~ s/[^\w\*%^+=:,.!-]/_/g; +} $group = '' if $nomail; $user .= '@'.$mdomain if $mdomain and $user !~ /@/; @@ -353,6 +355,7 @@ if ($user and $akey and defined $ab) { 'back to F*EX operation control' '' )); + exit; } else { $ab =~ s/[\r<>]//g; $ab =~ s/\s*$/\n/; @@ -515,9 +518,9 @@ if ($user and $pubkey) { local $/; local $_; - open $gf,">$gf.pk" or http_die("cannot write $gf - $!\n"); - print {$gf} <$pubkey>; - close $gf; + open $pk,">$gf.pk" or http_die("cannot write $gf.pk - $!\n"); + print {$pk} $pubkey; + close $pk; unlink $gf; system "gpg --batch --no-default-keyring --keyring $gf --import". "< $gf.pk >/dev/null 2>&1"; @@ -546,7 +549,7 @@ if ($user and $pubkey) { '$pk' '
    ' '

    ' - 'back' + 'back' '' )); } @@ -567,7 +570,6 @@ if ($user and $encryption) { '

    E-mails to you will be sent not encrypted.

    ' '

    ' 'back to F*EX operation control' - '' )); } elsif ($encryption eq 'CHANGE') { pq(qq( @@ -591,19 +593,19 @@ if ($user and $encryption) { '

    '
             '$g'
             '
    ' - '


    ' - '(*) To extract and verify your GPG public key use:' - '

    '
    -        'gpg -a --export $user > pubkey.gpg'
    -        'gpg < pubkey.gpg'
    -        '
    ' )); } - print "\n"; - exit; + pq(qq( + '


    ' + '(*) To extract and verify your GPG public key use:' + '

    '
    +      'gpg -a --export $user > pubkey.gpg'
    +      'gpg < pubkey.gpg'
    +      '
    ' + )); } - - &reexec; + print "\n"; + exit; } if ($user and $reminder eq 'yes') { @@ -647,18 +649,18 @@ if ($nid) { 'back to F*EX operation control' '' )); - exit; + &reexec; } # empty subuser list POST -if (defined(param('ssid')) and $ssid =~ /^\s*$/) { +if (defined($PARAM{'ssid'}) and $ssid =~ /^\s*$/) { unlink "$user/\@SUBUSER"; pq(qq( '

    All subusers deleted

    \n
      ' 'back to F*EX operation control' '' )); - exit; + &reexec; } # update sub-users @@ -1152,7 +1154,7 @@ sub handle_group { '

      ' 'back to F*EX operation control' )); - print end_html(); + print "\n"; exit; } else { # no group members -> delete group file @@ -1178,6 +1180,7 @@ sub handle_group { ' New group name: (You MUST fill out this field!)' ' ' )); + $gm = $user.':'.randstring(8); } else { if (open $gf,'<',$gf) { local $/; diff --git a/cgi-bin/fup b/cgi-bin/fup index d43cda0..b1e01e6 100755 --- a/cgi-bin/fup +++ b/cgi-bin/fup @@ -8,20 +8,16 @@ # Sebastian Zaiser (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; @@ -39,10 +35,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 ($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); our ($dkeydir,$ukeydir,$akeydir,$skeydir,$gkeydir,$xkeydir); +our ($MB,$DS); +our $RB; # read POST bytes (total) our $akey = ''; our $dkey = ''; our $skey = ''; @@ -54,7 +52,6 @@ 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 @@ -62,18 +59,18 @@ 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 ( +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 +79,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; @@ -116,6 +113,10 @@ if ($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 @@ -214,6 +215,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"||''); @@ -371,7 +377,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:/.*::; @@ -394,7 +400,7 @@ 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); + - int((time-mtime("$file/filename"))/$DS); if ($comment =~ /NOMAIL/ or (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) { printf "%8s MB [%s d] %s/%s/%s\n", @@ -438,11 +444,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"; @@ -461,7 +468,7 @@ 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); + - int((time-mtime("$file/filename"))/$DS); printf "%8s MB [%s d] %s%s\n", $size, $rkeep, @@ -493,7 +500,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:.*/(.+):; @@ -516,7 +523,7 @@ 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); + - int((time-mtime("$file/filename"))/$DS); printf "[delete] ", $akey,$dkey; printf "[forward] ", @@ -584,9 +591,9 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { 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+$/) { my @F = split; @@ -602,9 +609,9 @@ 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) { s/ \[[\d_]+\]//; @@ -694,14 +701,14 @@ if ($from and $id and $rid eq $id and @to and not $flink and not $seek) { # 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,8 +724,7 @@ 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? @@ -794,8 +800,8 @@ unless ($file) { } } - # 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; } @@ -836,8 +842,8 @@ unless ($file) { @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>"; @@ -845,7 +851,7 @@ unless ($file) { push @ab,""; } } - close $ab; + close $AB; } unless (@to) { @@ -909,12 +915,11 @@ 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' @@ -948,13 +953,14 @@ unless ($file) { 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( '