From: fextracker Date: Tue, 16 Jun 2015 20:08:16 +0000 (+0200) Subject: Original release 20150615 X-Git-Tag: 20150615 X-Git-Url: http://git.treefish.org/fex.git/commitdiff_plain/20150615?action=logout 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 --- 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(
       '