Original release 20160328

[fex.git] / cgi-bin / fac

diff --git a/cgi-bin/fac b/cgi-bin/fac
index 410eb6b06382811c799b585043b55b996f851b96..262975d65912dce9f929fcbc471206560d185526 100755 (executable)
--- a/cgi-bin/fac
+++ b/cgi-bin/fac
@@ -79,7 +79,7 @@ my @backup_files = qw(
 );
 
 # backup goes first
 );
 
 # backup goes first

-if ($action eq "backup") { 
+if ($action eq "backup") {

   &backup;
   exit;
 }
   &backup;
   exit;
 }


@@ -90,14 +90,14 @@ $_ = html_header("F*EX Admin Control for $hostname");
 s:</h1>: (<a href="?action=logout">logout</a>)</h1>:;
 print;
 
 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";
 
   "<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";


@@ -109,7 +109,7 @@ if (-f "$logdir/fexsrv.log") {
     $nav_log;
 }
 
     $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";
 


@@ -118,8 +118,8 @@ my $nav_show =
   "<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=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";
 
   "<li><a href=\"?action=editconfig\">Edit config</a>\n".
   "<li><a href=\"?action=editindex\">Edit index.html</a>\n";
 


@@ -143,24 +143,24 @@ pq(qq(
 
 my @user_items = &userList;
 
 
 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 "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 "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"});
 
 if (defined $PARAM{"createUser"}) {
   createUser($PARAM{"createUser"}, $PARAM{"authID"});


@@ -308,7 +308,7 @@ sub editRestrictionsForm {
 }
 
 # formular for choosing user, who shall be removed
 }
 
 # formular for choosing user, who shall be removed

-# required arguments: - 
+# required arguments: -

 sub deleteUserForm {
   my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
 
 sub deleteUserForm {
   my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
 


@@ -333,7 +333,7 @@ sub changeQuotaForm {
   my @option;
   my $rquota = '';
   my $squota = '';
   my @option;
   my $rquota = '';
   my $squota = '';

-  
+

   if ($user = $PARAM{"user"}) {
 
     $user = normalize_user($user);
   if ($user = $PARAM{"user"}) {
 
     $user = normalize_user($user);


@@ -398,21 +398,21 @@ sub restoreForm {
 sub createUser {
   my ($user,$id) = @_;
   my $idf;
 sub createUser {
   my ($user,$id) = @_;
   my $idf;

-  
+

   http_die("not enough arguments in createUser") unless $id;
   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 - $!");
   }
   $user = normalize_user($user);
 
   unless (-d "$user") {
     mkdir "$user",0755 or http_die("cannot mkdir $user - $!");
   }

-  
+

   $idf = "$user/@";
 
   if (-f $idf) {
   $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 - $!");
   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) = @_;
 # required arguments: username, auth-id
 sub changeUser {
   my ($user,$id) = @_;

-  
+

   http_die("not enough arguments in changeUser") unless $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>";
   $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 - $!");
   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);
 
   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>");
 
   chdir "$user" or http_die("could not change directory $user - $!");
   print h2("Config files of <code>$user</code>");
 


@@ -478,7 +478,7 @@ sub showUserConfig {
 sub editUser {
   my $user = shift;
   my $content;
 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;
   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 = @_);
 # required arguments: list of Files
 sub deleteFiles {
   http_die("not enough arguments in deleteFiles") unless (my @files = @_);

-    
+

   foreach (@files) {
     if (-e) {
       if (unlink $_) {
   foreach (@files) {
     if (-e) {
       if (unlink $_) {


@@ -531,9 +531,9 @@ sub deleteFiles {
 sub saveFile {
   my ($rf,$ar) = @_;
   my $new;
 sub saveFile {
   my ($rf,$ar) = @_;
   my $new;

-  
+

   http_die("not enough arguments in saveFile") unless $ar;
   http_die("not enough arguments in saveFile") unless $ar;

-  
+

   if ($ar eq 'index.html') {
     $ar = "$docdir/index.html"
   } elsif ($ar eq 'fex.ph') {
   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")
   }
   } else {
     http_die("unknown file $ar")
   }

-  
+

   $new = $ar.'_new';
   if ($ar =~ /fex.ph$/) {
     open $new,'>',$new or http_die("cannot open ${ar}_new - $!");
   $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;
 
   $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) {
   $rquota = $squota = '';
   $qf = "$user/\@QUOTA";
   if (open $qf,$qf) {


@@ -612,14 +612,14 @@ sub alterQuota {
     }
     close $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 = $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");
   $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";
 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 {
       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");
 # 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);
   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} =~ /:(.+)/;
 
   my $home = $FEXHOME;
   $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;

-  
+

   chdir $home or http_die("$home - $!");
   chdir $home or http_die("$home - $!");

-  
+

   unless (-d "backup") {
     mkdir "backup",0700 or http_die("cannot mkdir backup - $!");
   }
   unless (-d "backup") {
     mkdir "backup",0700 or http_die("cannot mkdir backup - $!");
   }

-  
+

   system "tar -cf $backup @backup_files 2>/dev/null";
   system "tar -cf $backup @backup_files 2>/dev/null";

-  
+

   $size = -s $backup or http_die("backup file empty");
   $size = -s $backup or http_die("backup file empty");

-  
+

   open $backup,'<',$backup or http_die("cannot open $backup - $!");
   open $backup,'<',$backup or http_die("cannot open $backup - $!");

-  
+

   nvt_print(
     'HTTP/1.1 200 OK',
     "Content-Length: $size",
   nvt_print(
     'HTTP/1.1 200 OK',
     "Content-Length: $size",


@@ -708,11 +708,11 @@ sub backup {
     "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
     "",
   );
     "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
     "",
   );

-  
+

   while (read($backup,my $b,$bs)) {
     print $b or last;
   }
   while (read($backup,my $b,$bs)) {
     print $b or last;
   }

-  
+

   exit;
 }
 
   exit;
 }
 


@@ -752,9 +752,9 @@ sub restore {
 sub editFile {
   my $ar = shift;
   my $file;
 sub editFile {
   my $ar = shift;
   my $file;

-  
+

   $file = dehtml(slurp($ar));
   $file = dehtml(slurp($ar));

-  
+

   $ar =~ s:.*/::;
 
   print h2("edit <code>$ar<code>");
   $ar =~ s:.*/::;
 
   print h2("edit <code>$ar<code>");


@@ -864,7 +864,7 @@ sub require_akey {
   } elsif ($akey) {
     # correct akey?
     return if $akey eq md5_hex("$admin:$rid");
   } 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");
 
   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 {
 # 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 = 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
   ) {
     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 /\./));
   }
     s/@/@./;
     $_ = join('.',reverse(split /\./));
   }

-  
+

   @d = sort { lc $a cmp lc $b } @d;
   @d = sort { lc $a cmp lc $b } @d;

-  
+

   foreach (@d) {
     $_ = join('.',reverse(split /\./));
     s/,/./g;
     s/@\./@/;
   }
   foreach (@d) {
     $_ = join('.',reverse(split /\./));
     s/,/./g;
     s/@\./@/;
   }

-  
+

   return @d;
 }
 
   return @d;
 }
 


@@ -983,12 +983,12 @@ sub userList {
   my (@u,@list);
   my $domain = '';
   my $u;
   my (@u,@list);
   my $domain = '';
   my $u;

-  
+

   foreach $u (glob('*@*')) {
     next if -l $u;
     push @u,$u if -f "$u/@";
   }
   foreach $u (glob('*@*')) {
     next if -l $u;
     push @u,$u if -f "$u/@";
   }

-  
+

   foreach (domainsort(@u)) {
     if (/@(.+)/) {
       if ($1 ne $domain) {
   foreach (domainsort(@u)) {
     if (/@(.+)/) {
       if ($1 ne $domain) {


@@ -998,14 +998,14 @@ sub userList {
       $domain = $1;
     }
   }
       $domain = $1;
     }
   }

-  
+

   return @list;
 }
 
 
 sub dumpfile {
   my $file = shift;
   return @list;
 }
 
 
 sub dumpfile {
   my $file = shift;

-  
+

   print "<pre>\n";
   while (<$file>) { print dehtml($_) }
   print "\n</pre>\n";
   print "<pre>\n";
   while (<$file>) { print dehtml($_) }
   print "\n</pre>\n";