Move Acl.read from start of slave loop to firewall handling case

[hcoop/domtool2.git] / src / main.sml

diff --git a/src/main.sml b/src/main.sml
index cf53af0..4b8123d 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -735,7 +735,9 @@ fun requestSmtpLog domain =
 
 fun requestMysqlFixperms () =
     let
-       val (_, bio) = requestBio (fn () => ())
+       val (_, context) = requestContext (fn () => ())
+       val bio = OpenSSL.connect true (context,
+                                       Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
     in
        Msg.send (bio, MsgMysqlFixperms);
        case Msg.recv bio of
@@ -751,7 +753,7 @@ fun requestMysqlFixperms () =
 fun requestApt {node, pkg} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
                                                     dispatcher
                                                 else
                                                     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
@@ -777,10 +779,39 @@ fun requestApt {node, pkg} =
        before OpenSSL.close bio
     end
 
+fun requestAptExists {node, pkg} =
+    let
+       val (user, context) = requestContext (fn () => ())
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+       val _ = Msg.send (bio, MsgQuery (QAptExists pkg))
+
+       fun loop () =
+           case Msg.recv bio of
+               NONE => (print "Server closed connection unexpectedly.\n";
+                        OS.Process.failure)
+             | SOME m =>
+               case m of
+                   MsgYes => (print "Package exists.\n";
+                              OS.Process.success)
+                 | MsgNo => (print "Package does not exist.\n";
+                             OS.Process.failure)
+                 | MsgError s => (print ("APT existence query failed: " ^ s ^ "\n");
+                                  OS.Process.failure)
+                 | _ => (print "Unexpected server reply.\n";
+                         OS.Process.failure)
+    in
+       loop ()
+       before OpenSSL.close bio
+    end
+
 fun requestCron {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
                                                     dispatcher
                                                 else
                                                     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
@@ -809,7 +840,7 @@ fun requestCron {node, uname} =
 fun requestFtp {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
                                                     dispatcher
                                                 else
                                                     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
@@ -838,7 +869,7 @@ fun requestFtp {node, uname} =
 fun requestTrustedPath {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
                                                     dispatcher
                                                 else
                                                     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
@@ -867,7 +898,7 @@ fun requestTrustedPath {node, uname} =
 fun requestSocketPerm {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
                                                     dispatcher
                                                 else
                                                     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
@@ -898,7 +929,7 @@ fun requestSocketPerm {node, uname} =
 fun requestFirewall {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
                                                     dispatcher
                                                 else
                                                     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
@@ -952,6 +983,31 @@ fun requestReUsers () =
        OpenSSL.close bio
     end
 
+fun requestFirewallRegen node = 
+    let
+       val (user, context) = requestContext (fn () => ())
+       val bio = OpenSSL.connect true (context, Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       (* Only supporting on slave nodes *)
+                 
+       val _ = Msg.send (bio, MsgFirewallRegen)
+
+       fun handleResult () =
+           case Msg.recv bio of
+               NONE => (print "Server closed connection unexpectedly.\n";
+                        OS.Process.failure)
+             | SOME m =>
+               case m of
+                   MsgOk => (print "Firewall regenerated.\n";
+                             OS.Process.success)
+                 | MsgError s => (print ("Firewall regeneration failed: " ^ s ^ "\n");
+                                  OS.Process.failure)
+                 | _ => (print "Unexpected server reply.\n";
+                         OS.Process.failure)
+    in
+       handleResult()
+       before OpenSSL.close bio
+    end
+
 structure SS = StringSet
 
 fun domainList dname =
@@ -1157,6 +1213,7 @@ fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
 fun answerQuery q =
     case q of
        QApt pkg => if Apt.installed pkg then MsgYes else MsgNo
+      | QAptExists pkg => if Apt.exists pkg then MsgYes else MsgNo
       | QCron user => if Cron.allowed user then MsgYes else MsgNo
       | QFtp user => if Ftp.allowed user then MsgYes else MsgNo
       | QTrustedPath user => if TrustedPath.query user then MsgYes else MsgNo
@@ -1166,6 +1223,7 @@ fun answerQuery q =
 fun describeQuery q =
     case q of
        QApt pkg => "Requested installation status of package " ^ pkg
+      | QAptExists pkg => "Requested if package " ^ pkg ^ " exists"
       | QCron user => "Asked about cron permissions for user " ^ user
       | QFtp user => "Asked about FTP permissions for user " ^ user
       | QTrustedPath user => "Asked about trusted path settings for user " ^ user
@@ -1505,18 +1563,6 @@ fun service () =
                                                 (describeQuery q,
                                                  NONE)))
                                      (fn () => ())
-
-                              | MsgMysqlFixperms =>
-                                (print "Starting mysql-fixperms\n";
-                                 doIt (fn () => if OS.Process.isSuccess
-                                                       (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
-                                                    ("Requested mysql-fixperms",
-                                                     NONE)
-                                                else
-                                                    ("Requested mysql-fixperms, but execution failed!",
-                                                     SOME "Script execution failed."))
-                                      (fn () => ()))
-
                               | MsgDescribe dom =>
                                 doIt (fn () => if not (Domain.validDomain dom) then
                                                    ("Requested description of invalid domain " ^ dom,
@@ -1745,6 +1791,30 @@ fun slave () =
                                                  ("Invalid database name " ^ user ^ "_" ^ dbname,
                                                   SOME ("Invalid database name " ^ dbname)))
                                          (fn () => ())
+                                  | MsgMysqlFixperms =>
+                                    (print "Starting mysql-fixperms\n";
+                                     doIt (fn () => if OS.Process.isSuccess
+                                                           (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
+                                                        ("Requested mysql-fixperms",
+                                                         NONE)
+                                                    else
+                                                        ("Requested mysql-fixperms, but execution failed!",
+                                                         SOME "Script execution failed."))
+                                          (fn () => ()))
+                                  | MsgFirewallRegen =>
+                                    doIt (fn () => (Acl.read Config.aclFile;
+                                                    if Acl.query {user = user, class = "priv", value = "all"} then
+                                                        if List.exists (fn x => x = host) Config.Firewall.firewallNodes then
+                                                            if (Firewall.generateFirewallConfig (Firewall.parseRules ()) andalso Firewall.publishConfig ())
+                                                            then
+                                                                ("Firewall rules regenerated.", NONE)
+                                                            else
+                                                               ("Rules regeneration failed!", SOME "Script execution failed.")
+                                                       else ("Node not controlled by domtool firewall.", SOME (host))
+                                                    else
+                                                        ("Not authorized to regenerate firewall.", SOME ("Unauthorized user " ^ user ^ " attempted to regenerated firewall"))))
+                                         (fn () => ())
+
                                   | _ => (OpenSSL.close bio;
                                           loop ())
                         end