);
# backup goes first
-if ($action eq "backup") {
+if ($action eq "backup") {
&backup;
exit;
}
s:</h1>: (<a href="?action=logout">logout</a>)</h1>:;
print;
-my $nav_user =
+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";
-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";
$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=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";
my @user_items = &userList;
-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 }
+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 "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 }
+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"});
}
# formular for choosing user, who shall be removed
-# required arguments: -
+# required arguments: -
sub deleteUserForm {
my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
my @option;
my $rquota = '';
my $squota = '';
-
+
if ($user = $PARAM{"user"}) {
$user = normalize_user($user);
sub createUser {
my ($user,$id) = @_;
my $idf;
-
+
http_die("not enough arguments in createUser") unless $id;
-
+
$user = normalize_user($user);
unless (-d "$user") {
mkdir "$user",0755 or http_die("cannot mkdir $user - $!");
}
-
+
$idf = "$user/@";
if (-f $idf) {
- html_error($error,"There is already an user $user!");
+ html_error($error,"There is already an user $user!");
}
-
+
open $idf,'>',$idf or http_die("cannot write $idf - $!");
print {$idf} $id,"\n";
close $idf or http_die("cannot write $idf - $!");
# required arguments: username, auth-id
sub changeUser {
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 - $!");
http_die("not enough arguments in showUserConfig!") unless $user;
$user = normalize_user($user);
-
+
chdir "$user" or http_die("could not change directory $user - $!");
print h2("Config files of <code>$user</code>");
sub editUser {
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;
# required arguments: list of Files
sub deleteFiles {
http_die("not enough arguments in deleteFiles") unless (my @files = @_);
-
+
foreach (@files) {
if (-e) {
if (unlink $_) {
sub saveFile {
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') {
} else {
http_die("unknown file $ar")
}
-
+
$new = $ar.'_new';
if ($ar =~ /fex.ph$/) {
open $new,'>',$new or http_die("cannot open ${ar}_new - $!");
$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) {
}
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");
sub watchLog {
if (-f "$logdir/fexsrv.log") {
print h2("polling fexsrv.log"),"\n";
- open my $log,"$FEXHOME/bin/logwatch|"
+ open my $log,"$FEXHOME/bin/logwatch|"
or http_die("cannot run $FEXHOME/bin/logwatch - $!");
dumpfile($log);
} else {
# required arguments: logfile-name
sub getlog {
my $log = shift or http_die("not enough arguments in getLog");
-
+
print h2("show $log");
if (open $log,"$logdir/$log") {
dumpfile($log);
my $home = $FEXHOME;
$home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
-
+
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-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
"",
);
-
+
while (read($backup,my $b,$bs)) {
print $b or last;
}
-
+
exit;
}
sub editFile {
my $ar = shift;
my $file;
-
+
$file = dehtml(slurp($ar));
-
+
$ar =~ s:.*/::;
print h2("edit <code>$ar<code>");
} elsif ($akey) {
# correct akey?
return if $akey eq md5_hex("$admin:$rid");
- }
+ }
http_header('200 OK');
print html_header("F*EX Admin Control for $hostname");
# function for checking simple HTTP authentication
# (not used any more, replaced with require_akey)
sub require_auth {
- if ($ENV{HTTP_AUTHORIZATION} and $ENV{HTTP_AUTHORIZATION} =~ /Basic\s+(.+)/)
+ if ($ENV{HTTP_AUTHORIZATION} and $ENV{HTTP_AUTHORIZATION} =~ /Basic\s+(.+)/)
{ @http_auth = split(':',decode_b64($1)) }
if (
- @http_auth != 2
+ @http_auth != 2
or $http_auth[0] !~ /^(fexmaster|admin|\Q$admin\E)$/
or $http_auth[1] ne $admin_pw
) {
s/@/@./;
$_ = join('.',reverse(split /\./));
}
-
+
@d = sort { lc $a cmp lc $b } @d;
-
+
foreach (@d) {
$_ = join('.',reverse(split /\./));
s/,/./g;
s/@\./@/;
}
-
+
return @d;
}
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) {
$domain = $1;
}
}
-
+
return @list;
}
sub dumpfile {
my $file = shift;
-
+
print "<pre>\n";
while (<$file>) { print dehtml($_) }
print "\n</pre>\n";
projects / fex.git / blobdiff