-#!/usr/bin/perl -w
+#!/usr/bin/perl -Tw
# 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;
+$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;
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(
close $x;
}
+our %PARAM;
+&parse_parameters;
+
+$action = $PARAM{"action"}||'';
+
# authentication
&require_akey;
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');
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 =
- 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 =
- 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 =
- 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 =
- 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 =
- 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;
-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 {
- if (defined param("remove quota")) {
- $user = param("userQuota");
- deleteFiles("$spooldir/$user/\@QUOTA");
- } else {
- alterQuota(param("userQuota"), param("recipientQuota"), param("senderQuota"));
- }
+ alterQuota(
+ $PARAM{"userQuota"},
+ $PARAM{"recipientQuota"},
+ $PARAM{"senderQuota"}
+ );
}
-
-} elsif (defined param("editUser")) {
- if (param("editUser") =~ /^#.*/) {
- &editRestrictionsForm;
+ }
+} elsif (defined $PARAM{"editUser"}) {
+ if ($PARAM{"editUser"} =~ /^#.*/) {
+ &editRestrictionsForm;
+ } else {
+ if (defined $PARAM{"delete file"}) {
+ $user = normalize_user($PARAM{"editUser"});
+ unlink "$user/\@ALLOWED_RECIPIENTS";
+ print "upload restrictions for $user have been deleted\n";
+ &end_html;
} else {
- if (defined param("delete file")) {
- $user = param("editUser");
- deleteFiles("$spooldir/$user/\@ALLOWED_RECIPIENTS");
- } else {
- editUser(param("editUser"));
- }
+ editUser($PARAM{"editUser"});
}
-
-} elsif (defined param("contentBox") && defined param("ar")) {
- saveFile(param("contentBox"), param("ar"));
-
-} elsif (defined param("upload_archive")) {
- restore(param("upload_archive"));
+ }
+} elsif ($PARAM{"contentBox"} and $PARAM{"ar"}) {
+ saveFile($PARAM{"contentBox"},$PARAM{"ar"});
+} elsif ($PARAM{"upload_archive"}) {
+ restore($PARAM{"upload_archive"}{data});
}
-print end_html();
-exit;
-
+&end_html;
#######
# declaration of formular functions
# 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 {
- 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 {
- 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 {
- 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 {
- 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 {
- 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 {
- $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 {
- 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;
}
# 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 {
- 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 {
- 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 {
- 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.
-# 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 :<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 {
- 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 {
- 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 {
- 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 {
- http_die("not enough arguments in createUser.\n") unless (my $user = $_[0]);
+ my $user = shift;
+
+ http_die("not enough arguments in deleteUser") unless $user;
+
+ $user = normalize_user($user);
- $idf = "$spooldir/$user/\@";
- http_die("no such user $user\n") unless -f $idf;
- unlink $idf or http_die("cannot remove $idf - $!\n");
- unlink "$spooldir/$user/\@ALLOWED_RECIPIENTS";
- print "$user deleted\n";
+ $idf = "$user/\@";
+ http_die("no such user $user") unless -f $idf;
+ unlink $idf or http_die("cannot remove $idf - $!");
+ unlink "$user/\@ALLOWED_RECIPIENTS";
+ unlink "$user/\@SUBUSER";
+ rmrf("$user/\@GROUP");
+ print "$user deleted\n";
+ &end_html;
}
# function for saving quota information for one single user
# required arguments: username, recipient-quota, sender-quota
sub alterQuota {
- http_die("not enough arguments in createUser.\n") unless (my ($user,$rq,$sq) = @_);
-
- $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
- unless (-d "$spooldir/$user") {
- http_die("$user is not a regular F*EX user\n");
- }
+ my ($user,$rq,$sq) = @_;
+ my ($rquota,$squota);
+ my $qf;
- $rquota = $squota = '';
- $qf = "$spooldir/$user/\@QUOTA";
- if (open $qf,'<',$qf) {
- while (<$qf>) {
- s/#.*//;
- $rquota = $1 if /recipient.*?(\d+)/i;
- $squota = $1 if /sender.*?(\d+)/i;
- }
- close $qf or http_die("cannot write $qf - $!\n");
- }
-
- open $qf,'>',$qf or http_die("cannot open $qf - $!\n");
- if(defined($rq) && $rq ne "") {
- $rquota = $1 if $rq =~ /(\d+)/i;
+ $user = normalize_user($user);
+ http_die("$user is not a F*EX user") unless -d $user;
+
+ $rquota = $squota = '';
+ $qf = "$user/\@QUOTA";
+ if (open $qf,$qf) {
+ while (<$qf>) {
+ s/#.*//;
+ $rquota = $1 if /recipient.*?(\d+)/i;
+ $squota = $1 if /sender.*?(\d+)/i;
}
- if(defined($sq) && $sq ne "") {
- $squota = $1 if $sq =~ /(\d+)/i;
- }
- print {$qf} "recipient:$rquota\n" if $rquota =~ /\d/;
- print {$qf} "sender:$squota\n" if $squota =~ /\d/;
- close $qf or http_die("cannot write $qf - $!\n");
-
- $rquota = $recipient_quota if $rquota !~ /\d/;
- $squota = $sender_quota if $squota !~ /\d/;
- print h3("New quotas for $user");
- print "recipient quota: $rquota MB\n", br;
- print "sender quota: $squota MB\n", br;
+ close $qf;
+ }
+
+ $rquota = $1 if $rq and $rq =~ /(\d+)/;
+ $squota = $1 if $sq and $sq =~ /(\d+)/;
+ open $qf,'>',$qf or http_die("cannot write $qf - $!");
+ print {$qf} "recipient:$rquota\n" if $rquota;
+ print {$qf} "sender:$squota\n" if $squota;
+ close $qf or http_die("cannot write $qf - $!");
+
+ $rquota = $recipient_quota unless $rquota;
+ $squota = $sender_quota unless $squota;
+ print h3("New quotas for $user");
+ print "recipient quota: $rquota MB<br>\n";
+ print "sender quota: $squota MB<br>\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 "<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 → $to : $durl/$dkey/$file\n";
+ }
}
- print "</code>\n";
+ }
+ print "</pre>\n";
+ &end_html;
}
# function for watching the fex-logfile
# required arguments: -
sub watchLog {
- if (-f 'fexsrv.log') {
+ if (-f "$logdir/fexsrv.log") {
print h2("polling fexsrv.log"),"\n";
open my $log,"$FEXHOME/bin/logwatch|"
- or http_die("cannot run $FEXHOME/bin/logwatch - $!\n");
+ or http_die("cannot run $FEXHOME/bin/logwatch - $!");
dumpfile($log);
} else {
- print h2("no fexsrv.log"),"\n";
+ print h2("no fexsrv.log");
}
+ &end_html;
}
# function for showing logfiles
# required arguments: logfile-name
sub getlog {
- my $log = shift or http_die("not enough arguments in getLog");
-
- print h2("show $log"),"\n";
- if (open $log,"$logdir/$log") {
- dumpfile($log);
- close $log;
- } else {
- http_die("cannot open $logdir/$log - $!\n");
- }
+ my $log = shift or http_die("not enough arguments in getLog");
+
+ print h2("show $log");
+ if (open $log,"$logdir/$log") {
+ dumpfile($log);
+ close $log;
+ } else {
+ http_die("cannot open $logdir/$log - $!");
+ }
+ &end_html;
}
# function for creating a new backup file
# required arguments: -
sub backup {
- my @d = localtime time;
- my $date = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
- my $backup = "backup/config-$date.tar";
- my $http_client = $ENV{HTTP_USER_AGENT} || '';
- my $size;
-
- my $home = $FEXHOME;
- $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
+ my @d = localtime time;
+ my $date = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
+ my $backup = "backup/config-$date.tar";
+ my $http_client = $ENV{HTTP_USER_AGENT} || '';
+ my $size;
+
+ my $home = $FEXHOME;
+ $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
- chdir $home or http_die("$home - $!\n");
-
- unless (-d "backup") {
- mkdir "backup",0700 or http_die("cannot mkdir backup - $!\n");
- }
-
- system "tar -cf $backup @backup_files 2>/dev/null";
-
- $size = -s $backup or http_die("backup file empty\n");
-
- open $backup,'<',$backup or http_die("cannot open $backup - $!\n");
-
- nvt_print(
- 'HTTP/1.1 200 OK',
- "Content-Length: $size",
- "Content-Type: application/octet-stream; filename=fex-backup-$date.tar",
- "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
- "",
- );
-
- while (read($backup,my $b,$bs)) {
- print $b or last;
- }
-
- exit;
+ chdir $home or http_die("$home - $!");
+
+ unless (-d "backup") {
+ mkdir "backup",0700 or http_die("cannot mkdir backup - $!");
+ }
+
+ system "tar -cf $backup @backup_files 2>/dev/null";
+
+ $size = -s $backup or http_die("backup file empty");
+
+ open $backup,'<',$backup or http_die("cannot open $backup - $!");
+
+ nvt_print(
+ 'HTTP/1.1 200 OK',
+ "Content-Length: $size",
+ "Content-Type: application/octet-stream; filename=fex-backup-$date.tar",
+ "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
+ "",
+ );
+
+ while (read($backup,my $b,$bs)) {
+ print $b or last;
+ }
+
+ exit;
}
# function for restoring an old configuration file
# required arguments: uploaded archive
sub restore {
- http_die("not enough arguments in restore!\n") unless (my $archive_file = $_[0]);
- my $restore = "backup.tar";
-
- my $home = $FEXHOME;
- $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
-
- chdir $home or http_die("$home - $!\n");
-
- open $restore,'>',$restore or http_die("cannot open $restore - $!");
-
- my $data;
- while(read $archive_file,$data,$bs) {
- print {$restore} $data;
- }
- close $restore or http_die("cannot write $restore - $!");
- if (-s $restore) {
- print "file upload successful, saving actual config in $home/backup/failsave.tar\n", br;
- system "tar -cf $home/backup/failsave.tar @backup_files 2>/dev/null";
- print "starting restore:\n<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 {
- 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 {
- 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 {
- 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;
- 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",
''
$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?
}
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>'
));
- exit;
+ &end_html;
}
}
}
+
# function for sending notification mails to an user
# required arguments: username, auth-id, message-type
sub notifyUser {
- http_die("not enough arguments in createUser.\n") unless (my ($user,$id) = @_);
- my $type = $_[2];
- my $message = 'A F*EX account has been created for you. Use';
+ my ($user,$id,$type) = @_;
+ my $url = $durl;
+ my $message = 'A F*EX account has been created for you. Use';
- if (defined($type) and $type eq "change-auth") {
- $message = 'New auth-ID for your F*EX account has been set. Use'
- }
+ http_die("not enough arguments in createUser") unless $id;
+ if ($type and $type eq "change-auth") {
+ $message = 'New auth-ID for your F*EX account has been set. Use'
+ }
- $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
- open my $mail,'|-',$sendmail,'-f',$admin,$user,$bcc
- or http_die("cannot start sendmail - $!\n");
- pq($mail,qq(
- 'From: $admin'
- 'To: $user'
- 'Subject: your F*EX account on $hostname'
- 'X-Mailer: F*EX'
- ''
- '$message'
- ''
- '$ENV{PROTO}://$ENV{HTTP_HOST}/fup?from=$user'
- 'auth-ID: $id'
- ''
- 'See http://$ENV{HTTP_HOST}/index.html for more information about F*EX.'
- ''
- 'Questions? ==> F*EX admin: $admin'
- ));
- close $mail
- or http_die("cannot send notification e-mail (sendmail error $!)\n");
+ $user = normalize_user($user);
+ open my $mail,'|-',$sendmail,'-f',$admin,$user,$bcc
+ or http_die("cannot start sendmail - $!");
+ $url =~ s:/fop::;
+ pq($mail,qq(
+ 'From: $admin'
+ 'To: $user'
+ 'Subject: your F*EX account on $hostname'
+ 'X-Mailer: F*EX'
+ ''
+ '$message'
+ ''
+ '$url/fup?from=$user'
+ 'auth-ID: $id'
+ ''
+ 'See $url/index.html for more information about F*EX.'
+ ''
+ 'Questions? ==> F*EX admin: $admin'
+ ));
+ close $mail
+ or http_die("cannot send notification e-mail (sendmail error $!)");
}
+
# sort key is the (inverse) domain
# required arguments: list of usernames (e-mail addresses)
sub domainsort {
-# http_die("not enough arguments in domainsort.\n") unless (my @d = @_);
- my @d = @_;
- local $_;
-
- foreach (@d) {
- s/ //g;
- s/^/ /;
- s/\./,/ while /\..*@/;
- s/@/@./;
- $_ = join('.',reverse(split /\./));
- }
-
- @d = sort { lc $a cmp lc $b } @d;
-
- foreach (@d) {
- $_ = join('.',reverse(split /\./));
- s/,/./g;
- s/@\./@/;
- }
-
- return @d;
+# http_die("not enough arguments in domainsort") unless (my @d = @_);
+ my @d = @_;
+ local $_;
+
+ foreach (@d) {
+ s/\s//g;
+ s/\./,/ while /\..*@/;
+ s/@/@./;
+ $_ = join('.',reverse(split /\./));
+ }
+
+ @d = sort { lc $a cmp lc $b } @d;
+
+ foreach (@d) {
+ $_ = join('.',reverse(split /\./));
+ s/,/./g;
+ s/@\./@/;
+ }
+
+ return @d;
}
# function for creating a sorted list of all users
# required arguments: -
sub userList {
- my @u;
- my $d = '';
-
- foreach (domainsort(grep { s:/@:: } glob('*@*/@'))) {
- s/ //g;
- /@(.+)/;
- if ($1 ne $d) {
- push @u,"### $1 ###";
- }
- push @u,$_;
- $d = $1;
+ my (@u,@list);
+ my $domain = '';
+ my $u;
+
+ foreach $u (glob('*@*')) {
+ next if -l $u;
+ push @u,$u if -f "$u/@";
+ }
+
+ foreach (domainsort(@u)) {
+ if (/@(.+)/) {
+ if ($1 ne $domain) {
+ push @list,"### $1 ###";
+ }
+ push @list,$_;
+ $domain = $1;
}
- return @u;
+ }
+
+ return @list;
}
my $file = shift;
print "<pre>\n";
- while (<$file>) {
- s/&/&/g;
- s/</</g;
- print or exit;
- }
+ while (<$file>) { print dehtml($_) }
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/&/&/g;
+ s/</</g;
+ return $_;
}
projects / fex.git / blobdiff