X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/97b87610331f53e756d032ad21db786037f921a1..20150826:/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 = "
  • Create new user\n". "
  • Change user auth-ID\n". "
  • Edit user restrictions file\n". "
  • Delete existing user\n". "
  • Manage disk quota\n"; -my $nav_log = +my $nav_log = "
  • Get fup.log\n". "
  • Get fop.log\n". "
  • Get error.log\n"; @@ -109,7 +109,7 @@ if (-f "$logdir/fexsrv.log") { $nav_log; } -my $nav_backup = +my $nav_backup = "
  • Download backup
    (config only)
    \n". "
  • Restore backup\n"; @@ -118,8 +118,8 @@ my $nav_show = "
  • Show quotas (sender/recipient)\n". "
  • Show server config\n". "
  • Show user config\n"; - -my $nav_edit = + +my $nav_edit = "
  • Edit config\n". "
  • Edit index.html\n"; @@ -143,24 +143,24 @@ pq(qq( 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"}); @@ -308,7 +308,7 @@ sub editRestrictionsForm { } # formular for choosing user, who shall be removed -# required arguments: - +# required arguments: - sub deleteUserForm { my @option = map { "\n" } @user_items; @@ -333,7 +333,7 @@ sub changeQuotaForm { my @option; my $rquota = ''; my $squota = ''; - + if ($user = $PARAM{"user"}) { $user = normalize_user($user); @@ -398,21 +398,21 @@ sub restoreForm { 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!"); } - + open $idf,'>',$idf or http_die("cannot write $idf - $!"); print {$idf} $id,"\n"; close $idf or http_die("cannot write $idf - $!"); @@ -429,15 +429,15 @@ sub createUser { # 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 "\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";