X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/7fa382617fbaccc0ce522b2b3adbbee9db5ad227..3aae246cf7f4af7ae49da09e5ed0c180f31f0c12:/cgi-bin/fac diff --git a/cgi-bin/fac b/cgi-bin/fac index 1470b83..a6a0012 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'); @@ -78,133 +90,137 @@ $_ = html_header("F*EX Admin Control for $hostname"); 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"; +my $nav_user = + "
  • 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"; +my $nav_log = + "
  • 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"; +my $nav_backup = + "
  • 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"; - -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"; + "
  • List spooled files\n". + "
  • Show quotas (sender/recipient)\n". + "
  • Show server config\n". + "
  • Show user config\n"; + +my $nav_edit = + "
  • 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 { + $user = normalize_user($PARAM{"editUser"}); + if (defined $PARAM{"delete file"}) { + 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($user); } - -} 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: - +# 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,454 @@ 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"); - } - } - - unless (-d "$spooldir/$user") { - mkdir "$spooldir/$user",0755 - or http_die("cannot mkdir $spooldir/$user - $!\n"); - } - - $idf = "$spooldir/$user/@"; + my ($user,$id) = @_; + my $idf; - if (-f $idf) { - 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"; + http_die("not enough arguments in createUser") unless $id; + + $user = normalize_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 - $!"); + 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]); - - 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; - } + my $user = shift; + + http_die("not enough arguments in showUserConfig!") unless $user; + $user = normalize_user($user); + + 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 = @_); - - 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; - } + http_die("not enough arguments in deleteFiles") unless (my @files = @_); + + 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 'mv',$ar,"$ar~";
+  }
+  $rf =~ s/^\s+$//;
+  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;
 
-    $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";
+  $user = normalize_user($user);
+
+  $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;
+
+  $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;
     }
+    close $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;
-    }
-    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;
+  $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");
+    open my $log,"$FEXHOME/bin/logwatch|"
+      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");
+  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");
-    }
+  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} =~ /:(.+)/;
-  
-    chdir $home or http_die("$home - $!\n");
-
-    unless (-d "backup") {
-	mkdir "backup",0700 or http_die("cannot mkdir backup - $!\n");
-    }
+  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;
 
-    system "tar -cf $backup @backup_files 2>/dev/null";
+  my $home = $FEXHOME;
+  $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
 
-    $size = -s $backup or http_die("backup file empty\n");
+  chdir $home or http_die("$home - $!");
 
-    open $backup,'<',$backup or http_die("cannot open $backup - $!\n");
+  unless (-d "backup") {
+    mkdir "backup",0700 or http_die("cannot mkdir 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;
-    }
+  system "tar -cf $backup @backup_files 2>/dev/null";
 
-    exit;
-}
+  $size = -s $backup or http_die("backup file empty");
 
-# 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";
+  open $backup,'<',$backup or http_die("cannot open $backup - $!");
 
-    my $home = $FEXHOME;
-    $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
+  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\"",
+    "",
+  );
 
-    chdir $home or http_die("$home - $!\n");
+  while (read($backup,my $b,$bs)) {
+    print $b or last;
+  }
 
-    open $restore,'>',$restore or http_die("cannot open $restore - $!");
+  exit;
+}
 
-    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");
-    }
+# function for restoring an old configuration file
+# required arguments: uploaded archive
+sub restore {
+  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 $/;
-  
-    open $ar,'<',$ar or http_die("cannot open $ar - $!");
-    $file = <$ar>;
-    close $ar;
+  my $ar = shift;
+  my $file;
+
+  $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 +854,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?
@@ -751,7 +865,7 @@ sub require_akey {
   } elsif ($akey) {
     # correct akey?
     return if $akey eq md5_hex("$admin:$rid");
-  }  
+  }
 
   http_header('200 OK');
   print html_header("F*EX Admin Control for $hostname");
@@ -773,24 +887,22 @@ sub require_akey {
   }
 
   pq(qq(
-    '
    '
+    ''
     '  auth-ID for $admin:'
     '  '
     '
    '
   ));
-  exit;
+  &end_html;
 }
 
 
 # function for checking simple HTTP authentication
 # (not used any more, replaced with require_akey)
 sub require_auth {
-  if ($ENV{HTTP_AUTHORIZATION} and $ENV{HTTP_AUTHORIZATION} =~ /Basic\s+(.+)/) 
+  if ($ENV{HTTP_AUTHORIZATION} and $ENV{HTTP_AUTHORIZATION} =~ /Basic\s+(.+)/)
   { @http_auth = split(':',decode_b64($1)) }
   if (
-    @http_auth != 2 
+    @http_auth != 2
     or $http_auth[0] !~ /^(fexmaster|admin|\Q$admin\E)$/
     or $http_auth[1] ne $admin_pw
   ) {
@@ -804,99 +916,126 @@ 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 /\./));
-    }
+#    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;
+  @d = sort { lc $a cmp lc $b } @d;
 
-    foreach (@d) {
-	$_ = join('.',reverse(split /\./));
-	s/,/./g;
-	s/@\./@/;
-    }
+  foreach (@d) {
+    $_ = join('.',reverse(split /\./));
+    s/,/./g;
+    s/@\./@/;
+  }
 
-    return @d;
+  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;
 }
 
 
 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/