X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/97b87610331f53e756d032ad21db786037f921a1..e5c93609849bda051fff54b5d5265af5608c6c69:/cgi-bin/fac?ds=inline diff --git a/cgi-bin/fac b/cgi-bin/fac index 410eb6b..6a41ab7 100755 --- a/cgi-bin/fac +++ b/cgi-bin/fac @@ -79,7 +79,7 @@ my @backup_files = qw( ); # backup goes first -if ($action eq "backup") { +if ($action eq "backup") { &backup; exit; } @@ -90,14 +90,14 @@ $_ = html_header("F*EX Admin Control for $hostname"); s:: (logout):; print; -my $nav_user = +my $nav_user = "
\n";
print "$idf";
-
+
open $idf,'>',$idf or http_die("cannot write $idf - $!");
print {$idf} $id,"\n";
close $idf or http_die("cannot write $idf - $!");
@@ -456,7 +456,7 @@ sub showUserConfig {
http_die("not enough arguments in showUserConfig!") unless $user;
$user = normalize_user($user);
-
+
chdir "$user" or http_die("could not change directory $user - $!");
print h2("Config files of $user
");
@@ -478,7 +478,7 @@ sub showUserConfig {
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;
@@ -511,7 +511,7 @@ EOD
# required arguments: list of Files
sub deleteFiles {
http_die("not enough arguments in deleteFiles") unless (my @files = @_);
-
+
foreach (@files) {
if (-e) {
if (unlink $_) {
@@ -531,9 +531,9 @@ sub deleteFiles {
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') {
@@ -543,7 +543,7 @@ sub saveFile {
} else {
http_die("unknown file $ar")
}
-
+
$new = $ar.'_new';
if ($ar =~ /fex.ph$/) {
open $new,'>',$new or http_die("cannot open ${ar}_new - $!");
@@ -601,7 +601,7 @@ sub alterQuota {
$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) {
@@ -612,14 +612,14 @@ sub alterQuota {
}
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");
@@ -653,7 +653,7 @@ sub listFiles {
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 {
@@ -666,7 +666,7 @@ sub watchLog {
# 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);
@@ -688,19 +688,19 @@ sub backup {
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",
@@ -708,11 +708,11 @@ sub backup {
"Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
"",
);
-
+
while (read($backup,my $b,$bs)) {
print $b or last;
}
-
+
exit;
}
@@ -752,9 +752,9 @@ sub restore {
sub editFile {
my $ar = shift;
my $file;
-
+
$file = dehtml(slurp($ar));
-
+
$ar =~ s:.*/::;
print h2("edit $ar");
@@ -864,7 +864,7 @@ sub require_akey {
} elsif ($akey) {
# correct akey?
return if $akey eq md5_hex("$admin:$rid");
- }
+ }
http_header('200 OK');
print html_header("F*EX Admin Control for $hostname");
@@ -898,10 +898,10 @@ sub require_akey {
# 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
) {
@@ -965,15 +965,15 @@ sub domainsort {
s/@/@./;
$_ = join('.',reverse(split /\./));
}
-
+
@d = sort { lc $a cmp lc $b } @d;
-
+
foreach (@d) {
$_ = join('.',reverse(split /\./));
s/,/./g;
s/@\./@/;
}
-
+
return @d;
}
@@ -983,12 +983,12 @@ sub userList {
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) {
@@ -998,14 +998,14 @@ sub userList {
$domain = $1;
}
}
-
+
return @list;
}
sub dumpfile {
my $file = shift;
-
+
print "\n";
while (<$file>) { print dehtml($_) }
print "\n
\n";