]> git.treefish.org Git - fex.git/blobdiff - cgi-bin/fac
projects / fex.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Original release 20150729
[fex.git] / cgi-bin / fac
diff --git a/cgi-bin/fac b/cgi-bin/fac
index 1470b83c1f266e5eda46726599cafbae56954947..410eb6b06382811c799b585043b55b996f851b96 100755 (executable)
--- 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
 #
 
 # F*EX CGI for administration
 #
-# Author: Andre Hafner <andrehafner@gmx.net>
+# Original author: Andre Hafner <andrehafner@gmx.net>
 #
 
 #
 
-use CGI                        qw(:standard);
-use CGI::Carp          qw(fatalsToBrowser);
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
 
 $| = 1;
 
 
 $| = 1;
 
+$fac = $0;
+$fac =~ s:.*/::;
+
 # add fex lib
 # 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
 
 # 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
 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;
 
 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
 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(
   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;
 }
 
   close $x;
 }
 
+our %PARAM;
+&parse_parameters;
+
+$action = $PARAM{"action"}||'';
+
 # authentication
 &require_akey;
 
 # authentication
 &require_akey;
 
@@ -61,16 +69,20 @@ $fup =~ s:/fop:/fup:;
 
 my $http_client = $ENV{HTTP_USER_AGENT} || '';
 
 
 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/*@*/@*
 my @backup_files = qw(
   htdocs/index.html
   lib/fex.ph
   lib/fup.pl
   spool/*@*/@*
+  spool/*@*/.auto
 );
 
 # backup goes first
 );
 
 # backup goes first
-if (defined param("action") and param("action") eq "backup") { &backup }
+if ($action eq "backup") { 
+  &backup;
+  exit;
+}
 
 http_header('200 OK');
 
 
 http_header('200 OK');
 
@@ -79,132 +91,136 @@ s:</h1>: (<a href="?action=logout">logout</a>)</h1>:;
 print;
 
 my $nav_user = 
 print;
 
 my $nav_user = 
-  li("<a href=\"?action=create\">Create new user</a>") . "\n" .
-  li("<a href=\"?action=change-auth\">Change user auth-ID</a>") . "\n" .
-  li("<a href=\"?action=edit\">Edit user restrictions file</a>") . "\n" .
-  li("<a href=\"?action=delete\">Delete existing user</a>") . "\n" .
-  li("<a href=\"?action=quota\">Manage disk quota</a>") . "\n";
+  "<li><a href=\"?action=create\">Create new user</a>\n".
+  "<li><a href=\"?action=change-auth\">Change user auth-ID</a>\n".
+  "<li><a href=\"?action=edit\">Edit user restrictions file</a>\n".
+  "<li><a href=\"?action=delete\">Delete existing user</a>\n".
+  "<li><a href=\"?action=quota\">Manage disk quota</a>\n";
 
 my $nav_log = 
 
 my $nav_log = 
-  li("<a href=\"?action=fup.log\">Get fup.log</a>") . "\n" .
-  li("<a href=\"?action=fop.log\">Get fop.log</a>") . "\n" .
-  li("<a href=\"?action=error.log\">Get error.log</a>") . "\n";
+  "<li><a href=\"?action=fup.log\">Get fup.log</a>\n".
+  "<li><a href=\"?action=fop.log\">Get fop.log</a>\n".
+  "<li><a href=\"?action=error.log\">Get error.log</a>\n";
 
 
-if (-f 'fexsrv.log') {
+if (-f "$logdir/fexsrv.log") {
   $nav_log =
   $nav_log =
-    li("<a href=\"?action=watch\">Watch logfile</a>") . "\n" .
-    li("<a href=\"?action=fexsrv.log\">Get fexsrv.log</a>") . "\n" .
-  $nav_log;
+    "<li><a href=\"?action=watch\">Watch logfile</a>\n".
+    "<li><a href=\"?action=fexsrv.log\">Get fexsrv.log</a>\n".
+    $nav_log;
 }
 
 my $nav_backup = 
 }
 
 my $nav_backup = 
-  li("<a href=\"?action=backup\">Download backup<br>(config only)</a>") . "\n" .
-  li("<a href=\"?action=restore\">Restore backup</a>") . "\n";
+  "<li><a href=\"?action=backup\">Download backup<br>(config only)</a>\n".
+  "<li><a href=\"?action=restore\">Restore backup</a>\n";
 
 my $nav_show =
 
 my $nav_show =
-  li("<a href=\"?action=list\">List spooled files</a>") . "\n" .
-  li("<a href=\"?action=showquota\">Show quotas (sender/recipient)</a>") . "\n" .
-  li("<a href=\"?action=showconfig\">Show server config</a>") . "\n" .
-  li("<a href=\"?action=userconfig\">Show user config</a>") . "\n";
+  "<li><a href=\"?action=list\">List spooled files</a>\n".
+  "<li><a href=\"?action=showquota\">Show quotas (sender/recipient)</a>\n".
+  "<li><a href=\"?action=showconfig\">Show server config</a>\n".
+  "<li><a href=\"?action=userconfig\">Show user config</a>\n";
   
 my $nav_edit =  
   
 my $nav_edit =  
-  li("<a href=\"?action=editconfig\">Edit config</a>") . "\n" .
-  li("<a href=\"?action=editindex\">Edit index.html</a>") . "\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 "<hr>\n";
+  "<li><a href=\"?action=editconfig\">Edit config</a>\n".
+  "<li><a href=\"?action=editindex\">Edit index.html</a>\n";
+
+pq(qq(
+  '<table border="0">'
+  '  <th>manage user</th>'
+  '  <th>show</th>'
+  '  <th>log files</th>'
+  '  <th>edit</th>'
+  '  <th>backup</th>'
+  '  <tr valign="top">'
+  '    <td><ul>$nav_user</ul>'
+  '    <td><ul>$nav_show</ul>'
+  '    <td><ul>$nav_log</ul>'
+  '    <td><ul>$nav_edit</ul>'
+  '    <td><ul>$nav_backup</ul>'
+  '  </tr>'
+  '</table>'
+  '<hr>'
+));
 
 my @user_items = &userList;
 
 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:<p>\n";
+      print "recipient quota: $recipient_quota MB<br>\n";
+      print "sender quota: $sender_quota MB<br>\n";
+      &end_html;
     } else {
     } 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 {
     } 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
 
 #######
 # declaration of formular functions
@@ -213,102 +229,163 @@ exit;
 # formular for creating new users
 # required arguments: -
 sub createUserForm {
 # 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(
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user</td><td><input type="text" name="createUser" size="80"></td>'
+    '</tr>'
+    '<tr>'
+    '<td>auth-ID:</td><td><input type="text" name="authID" size="16"></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="create user" value="create user">'
+    '</form>'
+  ));
+  &end_html;
 }
 
 # formular for changing auth-id of an user
 # required arguments: -
 sub changeAuthForm {
 }
 
 # 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 { "<option value=\"$_\">$_</option>\n" } @user_items;
+
+  print h3("change auth-ID");
+  pq(qq(
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="changeAuthUser">@option</select></td>'
+    '</tr>'
+    '<tr>'
+    '<td>new auth-ID:</td><td><input type="text" name="authID" size="16"></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="change" value="change">'
+    '</form>'
+  ));
+  &end_html;
 }
 
 # formular choosing user, whose config files shall be shown
 # required arguments: -
 sub userConfigForm {
 }
 
 # 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 { "<option value=\"$_\">$_</option>\n" } @user_items;
+
+  print h3("Show user config files");
+  pq(qq(
+    '<form action="/$fac" method="post enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="showUserConfig">@option</select></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="show config files" value="show config files">'
+    '</form>'
+  ));
+  &end_html;
 }
 
 # formular for choosing user, whose restriction file shall be edited
 # required arguments: -
 sub editRestrictionsForm {
 }
 
 # 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 { "<option value=\"$_\">$_</option>\n" } @user_items;
+
+  print h3("Edit user restriction file");
+  pq(qq(
+    '<form action="/$fac" method="post enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="editUser">@option</select></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="edit file" value="edit file">'
+    '<input type="submit" name="delete file" value="delete file">'
+    '</form>'
+  ));
+  &end_html;
 }
 
 # formular for choosing user, who shall be removed
 # required arguments: - 
 sub deleteUserForm {
 }
 
 # 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 { "<option value=\"$_\">$_</option>\n" } @user_items;
 
 
-    print "\n", end_form;
+  print h3("Delete existing user");
+  pq(qq(
+    '<form action="/$fac" method="post enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="deleteUser">@option</select></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="delete user" value="delete user">'
+    '</form>'
+  ));
+  &end_html;
 }
 
 # formular for changing an user's quota file
 # required arguments: -
 sub changeQuotaForm {
 }
 
 # 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 = "<select name=\"userQuota\">\n";
-       foreach (@user_items) {
-           if ($_ eq param("user")) {
-               $dropdownMenu .= "<option value=\"$_\" selected>$_</option>";
-           } else {
-               $dropdownMenu .= "<option value=\"$_\">$_</option>";
-           }
-       }
-       $dropdownMenu .= "</select>\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,"<option value=\"$_\" selected>$_</option>\n";
     } else {
     } else {
-       $dropdownMenu = popup_menu(-name=>"userQuota", -values=>\@user_items);
+      push @option,"<option value=\"$_\">$_</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(
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="userQuota">@option</select></td>'
+    '</tr>'
+    '<tr>'
+    '<td>new quota for recipient:</td>'
+    '<td><input type="text" name="recipientQuota" size="12" value=\"$rquota\">'
+    ' MB (optional)</td>'
+    '</tr>'
+    '<tr>'
+    '<td>new quota for sender:</td>'
+    '<td><input type="text" name="senderQuota" size="12" value=\"$squota\">'
+    ' MB (optional)</td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="change quota" value="change quota">'
+    '<input type="submit" name="default quota" value="default quota">'
+    '</form>'
+  ));
+  &end_html;
 }
 
 # formular for choosing backup file to restore
 # required arguments: -
 sub restoreForm {
 }
 
 # 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:<br>'
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<input type="file" name="upload_archive" size="80"><br>'
+    '<input type="submit" name="restore" value="restore">'
+    '</form>'
+  ));
+  &end_html;
 }
 
 
 }
 
 
@@ -319,417 +396,453 @@ sub restoreForm {
 # function for creating new users
 # required arguments: username, auth-id
 sub createUser {
 # 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 "<code>\n";
-    printf "%s?from=%s&ID=%s<br>\n",$fup,$user,$id;
-    printf "%s/%s<p>\n",$fup,b64("from=$user&id=$id");
-    print "</code>\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 "<code>\n";
+  printf "%s?from=%s&ID=%s<br>\n",$fup,$user,$id;
+  printf "%s/%s<p>\n",$fup,b64("from=$user&id=$id");
+  print "</code>\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 {
 }
 
 # 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 "<code>\n";
-    print "$idf<p>";
-
-    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<br>\n",$fup,$user,$id;
-    printf "%s/%s\n",$fup,b64("from=$user&id=$id");
-    print "</code><p>\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 "<code>\n";
+  print "$idf<p>";
+  
+  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<br>\n",$fup,$user,$id;
+  printf "%s/%s\n",$fup,b64("from=$user&id=$id");
+  print "</code><p>\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 {
 }
 
 # 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 <code>$user</code>");
-
-    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 "<table border=1><tr><td>\n";
-            dumpfile($file);
-            # print "</tr></table>\n";
-           close $file;
-       }
+  chdir "$user" or http_die("could not change directory $user - $!");
+  print h2("Config files of <code>$user</code>");
+
+  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 "<table border=1><tr><td>\n";
+      dumpfile($file);
+      # print "</tr></table>\n";
+      close $file;
     }
     }
+  }
+  &end_html;
 }
 
 # function for editing an user's recipient/sender restrictions
 # required arguments: username
 sub editUser {
 }
 
 # 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<<EOD;
+  my $user = shift;
+  my $content;
+  
+  http_die("not enough arguments in editUser") unless $user;
+  $user = normalize_user($user);
+  http_die("no user $user") unless -d $user;
+  my $ar = "$user/\@ALLOWED_RECIPIENTS";
+  unless (-f $ar) {
+    open $ar,'>',$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.
 # 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
 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 :<br>'
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<textarea name="contentBox"  rows="10" cols="80">'
+    '$content'
+    '</textarea><br>'
+    '<input type="hidden" name="ar" value="$ar">'
+    '<input type="submit" name="save changes" value="save changes">'
+    '</form>'
+  ));
+  &end_html;
 }
 
 # function for deleting files
 # required arguments: list of Files
 sub deleteFiles {
 }
 
 # 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: $_<br>\n";
+      } else {
+        print "file could not be deleted: $_ - $!<br>\n";
+      }
+    } else {
+      print "file does not exists: $_<br>\n";
     }
     }
+  }
+  &end_html;
 }
 
 # function for saving a single file
 # required arguments: content, location
 sub saveFile {
 }
 
 # 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:'
-              '<p>'
-              '<pre>$status</pre>'
-            ));
-            &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<p>\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 {
     } else {
-        print "<pre>\n";
-       print while <$file>;
+      rename "$ar~",$ar;
+      pq(qq(
+        'No valid syntax in configuration file:'
+        '<p><pre>$status</pre><p>'
+        '<a href="javascript:history.back()">back</a>'
+      ));
+      &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 "<code>$ar</code> has been saved\n";
+  &end_html;
 }
 
 # function for deleting existing user
 # required arguments: username
 sub deleteUser {
 }
 
 # 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 {
 }
 
 # 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<br>\n";
+  print "sender quota: $squota MB<br>\n";
+  &end_html;
 }
 
 # function for listing f*exed files
 # required arguments: -
 sub listFiles {
 }
 
 # 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 "<code>\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<br>\n";
-        }
+  print h3("List current files");
+  my ($file,$dkey);
+  print "<pre>\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 &rarr; $to : $durl/$dkey/$file\n";
+      }
     }
     }
-    print "</code>\n";
+  }
+  print "</pre>\n";
+  &end_html;
 }
 
 # function for watching the fex-logfile
 # required arguments: -
 sub watchLog {
 }
 
 # 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|" 
     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 {
     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 {
 }
 
 # 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 {
 }
 
 # 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 {
 }
 
 # 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<p><pre>\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<br>\n";
+    print "saving actual config in $home/backup/config.tar<br>\n";
+    print "<pre>\n";
+    system "tar -cf backup/config.tar @backup_files";
+    print "</pre>\n";
+    print "starting restore:\n<p>\n";
+    print "<pre>\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 {
 }
 
 # 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 <code>$ar<code>");
+
+  pq(qq(
+    '<form action="/$fac" enctype="multipart/form-data" method="post">'
+    '<textarea name="contentBox" rows="26" cols="80">'
+    '$file'
+    '</textarea><br>'
+    '<input type="hidden" name="ar" value="$ar">'
+    '<input type="submit" name="save changes" value="save changes">'
+    '</form>'
+  ));
+  &end_html;
 }
 
 # function for showing all users' quotas
 # required arguments: -
 sub showQuota {
 }
 
 # 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<p>\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, 
-              "<td><a href=\"?action=quota&user=$user&rquota=$rquota&squota=$squota\">$_</a></td>".
-              "<td align=\"right\">$squota</td>".
-              "<td align=\"right\">$squota_used</td>".
-              "<td align=\"right\">$rquota</td>".
-              "<td align=\"right\">$rquota_used</td>";
-       }
+
+  print h2("Show quotas (domain sorted, values in MB)");
+  print "<table border=\"1\"><tr>";
+  foreach (@user_items) {
+    if (/\#\#\#\s(\S+)/) {
+      print "<tr>";
+      print "<th>\@$1</th>";
+      print "<th>sender</th>";
+      print "<th>sender (used)</th>";
+      print "<th>recipient</th>";
+      print "<th>recipient (used)</th>";
+      print "</tr>\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 "<tr>";
+      print "<td><a href=\"?action=$action\">$_</a></td>";
+      print "<td align=\"right\">$squota</td>";
+      print "<td align=\"right\">$squota_used</td>";
+      print "<td align=\"right\">$rquota</td>";
+      print "<td align=\"right\">$rquota_used</td>";
+      print "</tr>\n";
     }
     }
-    print table({-border=>1},Tr([@table_content])), "\n";
+  }
+  print "</table>\n";
+  &end_html;
+
 }
 
 # function for showing fex-server configuration
 # required arguments: -
 sub showConfig {
 }
 
 # 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 "<table border=\"0\">\n";
+  printf "<tr><td>spooldir:</td><td>%s</td>\n",$spooldir;
+  printf "<tr><td>logdir:</td><td>%s</td>\n",$logdir;
+  printf "<tr><td>docdir:</td><td>%s</td>\n",$docdir;
+  printf "<tr><td>durl:</td><td>%s</td>\n",$durl;
+  printf "<tr><td>mdomain:</td><td>%s</td>\n",$mdomain||'';
+  printf "<tr><td>autodelete:</td><td>%s</td>\n",$autodelete;
+  printf "<tr><td>keep:</td><td>%s</td>\n",$keep_default;
+  printf "<tr><td>keep_max:</td><td>%s</td>\n",$keep_max;
+  printf "<tr><td>recipient_quota:</td><td>%s</td>\n",$recipient_quota;
+  printf "<tr><td>sender_quota:</td><td>%s</td>\n",$sender_quota;
+  printf "<tr><td>admin:</td><td>%s</td>\n",$admin;
+  print "</table>\n";
+  &end_html;
 }
 
 # require authentification
 sub require_akey {
   my $id;
   my $rid;
 }
 
 # 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",
     nvt_print(
       "HTTP/1.1 301 Moved Permanently",
-      "Location: /fac",
+      "Location: /$fac",
       'Content-Length: 0',
       "Set-Cookie: akey=; Max-Age=0; Discard",
       ''
       '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;
 
   $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?
 
   if ($id) {
     # correct auth-ID?
@@ -773,14 +886,12 @@ sub require_akey {
   }
 
   pq(qq(
   }
 
   pq(qq(
-    '<form action="/fac" '
-    '      method="post" '
-    '      enctype="multipart/form-data">'
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
     '  auth-ID for <code>$admin</code>:'
     '  <input type="password" name="id" size="16" autocomplete="off">'
     '</form>'
   ));
     '  auth-ID for <code>$admin</code>:'
     '  <input type="password" name="id" size="16" autocomplete="off">'
     '</form>'
   ));
-  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 {
 # 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 {
 # 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 {
 }
 
 # 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 "<pre>\n";
   my $file = shift;
   
   print "<pre>\n";
-  while (<$file>) {
-    s/&/&amp;/g;
-    s/</&lt;/g;
-    print or exit;
-  }
+  while (<$file>) { print dehtml($_) }
   print "\n</pre>\n";
 }
 
 
   print "\n</pre>\n";
 }
 
 
-sub error {
-    print join("\n",@_),"\n";
-    print end_html();
-    exit;
+sub h2 {
+  local $_ = shift;
+  chomp;
+  return "<h2>$_</h2>\n";
+}
+
+
+sub h3 {
+  local $_ = shift;
+  chomp;
+  return "<h3>$_</h3>\n";
+}
+
+
+sub end_html {
+  print "</body></html>\n";
+  exit;
+}
+
+
+sub dehtml {
+  local $_ = shift;
+  s/&/&amp;/g;
+  s/</&lt;/g;
+  return $_;
 }
 }
Unofficial F*EX git repository tracking official releases.