Re-enable querying user firewall rules

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

diff --git a/src/main.sml b/src/main.sml
index f2beee8..5783348 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -779,6 +779,38 @@ fun requestApt {node, pkg} =
        before OpenSSL.close bio
     end
 
        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
+                   MsgAptQuery {section,description}  =>  (print "Package exists.\n";
+                                                           print ("Section: " ^ section ^ "\n");
+                                                           print ("Description: " ^ description ^ "\n");
+                                                           OS.Process.success)
+                 | MsgNo => (print "Package does not exist.\n";
+                             OS.Process.failure
+                            (* It might be the Wrong Thing (tm) to use MsgNo like this *))
+                 | 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 () => ())
 fun requestCron {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())


@@ -905,7 +937,7 @@ fun requestFirewall {node, uname} =
                                                 else
                                                     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
                  
                                                 else
                                                     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
                  

-       val _ = Msg.send (bio, MsgQuery (QFirewall uname))
+       val _ = Msg.send (bio, MsgQuery (QFirewall {node = node, user = uname}))

 
        fun loop () =
            case Msg.recv bio of
 
        fun loop () =
            case Msg.recv bio of


@@ -1184,20 +1216,24 @@ fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
 fun answerQuery q =
     case q of
        QApt pkg => if Apt.installed pkg then MsgYes else MsgNo
 fun answerQuery q =
     case q of
        QApt pkg => if Apt.installed pkg then MsgYes else MsgNo

+      | QAptExists pkg => (case Apt.info pkg of
+                             SOME {section, description} => MsgAptQuery {section = section, description = description}
+                           | NONE => 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
       | QSocket user => MsgSocket (SocketPerm.query user)
       | 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
       | QSocket user => MsgSocket (SocketPerm.query user)

-      | QFirewall user => MsgFirewall (Firewall.query user)
+      | QFirewall {node, user} => MsgFirewall (Firewall.query (node, user))

 
 fun describeQuery q =
     case q of
        QApt pkg => "Requested installation status of package " ^ pkg
 
 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
       | QSocket user => "Asked about socket permissions for user " ^ user
       | 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
       | QSocket user => "Asked about socket permissions for user " ^ user

-      | QFirewall user => "Asked about firewall rules for user " ^ user
+      | QFirewall {node, user} => "Asked about firewall rules on " ^ node ^ " for user " ^ user

 
 fun doIt' loop bio f cleanup =
               ((case f () of
 
 fun doIt' loop bio f cleanup =
               ((case f () of


@@ -1771,16 +1807,17 @@ fun slave () =
                                                          SOME "Script execution failed."))
                                           (fn () => ()))
                                   | MsgFirewallRegen =>
                                                          SOME "Script execution failed."))
                                           (fn () => ()))
                                   | MsgFirewallRegen =>

-                                    doIt (fn () => 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
+                                    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))
                                                                ("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")))
+                                                    else
+                                                        ("Not authorized to regenerate firewall.", SOME ("Unauthorized user " ^ user ^ " attempted to regenerated firewall"))))

                                          (fn () => ())
 
                                   | _ => (OpenSSL.close bio;
                                          (fn () => ())
 
                                   | _ => (OpenSSL.close bio;