Move ambient environment defaults into Env.env

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

diff --git a/src/main.sml b/src/main.sml
index 6df1525..6cb3ef1 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -1,5 +1,6 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
  * Copyright (c) 2006-2009, Adam Chlipala
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
  * Copyright (c) 2006-2009, Adam Chlipala

+ * Copyright (c) 2012,2013,2014 Clinton Ebadi <clinton@unknownlamer.org>

  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License


@@ -50,7 +51,7 @@ fun check' G fname =
                 ()
             else
                 Option.app (Unused.check G) (#3 prog);
                 ()
             else
                 Option.app (Unused.check G) (#3 prog);

-            Tycheck.checkFile G (Defaults.tInit prog) prog)
+            Tycheck.checkFile G prog)

     end
 
 fun basis () =
     end
 
 fun basis () =


@@ -100,7 +101,7 @@ fun check G fname =
                    raise ErrorMsg.Error
                else
                    let
                    raise ErrorMsg.Error
                else
                    let

-                       val G' = Tycheck.checkFile G (Defaults.tInit prog) prog
+                       val G' = Tycheck.checkFile G prog

                    in
                        if !ErrorMsg.anyErrors then
                            raise ErrorMsg.Error
                    in
                        if !ErrorMsg.anyErrors then
                            raise ErrorMsg.Error


@@ -795,10 +796,13 @@ fun requestAptExists {node, pkg} =
                         OS.Process.failure)
              | SOME m =>
                case m of
                         OS.Process.failure)
              | SOME m =>
                case m of

-                   MsgYes => (print "Package exists.\n";
-                              OS.Process.success)
+                   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";
                  | MsgNo => (print "Package does not exist.\n";

-                             OS.Process.failure)
+                             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";
                  | MsgError s => (print ("APT existence query failed: " ^ s ^ "\n");
                                   OS.Process.failure)
                  | _ => (print "Unexpected server reply.\n";


@@ -934,7 +938,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


@@ -1145,7 +1149,9 @@ fun regenerateEither tc checker context =
                             ok := false)
                        else
                            ();
                             ok := false)
                        else
                            ();

-                       ignore (foldl checker' (basis (), Defaults.eInit ()) files)
+                       let val basis' = basis () in
+                           ignore (foldl checker' (basis', Env.initialDynEnvVals basis') files)
+                       end

                    end
                else if String.isSuffix "_admin" user then
                    ()    
                    end
                else if String.isSuffix "_admin" user then
                    ()    


@@ -1213,12 +1219,14 @@ 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 => if Apt.exists 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
 
 fun describeQuery q =
     case q of


@@ -1228,7 +1236,7 @@ fun describeQuery q =
       | 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
       | 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


@@ -1308,7 +1316,9 @@ fun service () =
                                 end
                         in
                             doIt (fn () => (Env.pre ();
                                 end
                         in
                             doIt (fn () => (Env.pre ();

-                                            ignore (foldl doOne (basis (), Defaults.eInit ()) codes);
+                                            let val basis' = basis () in
+                                                ignore (foldl doOne (basis', Env.initialDynEnvVals basis') codes)
+                                            end;

                                             Env.post ();
                                             Msg.send (bio, MsgOk);
                                             ("Configuration complete.", NONE)))
                                             Env.post ();
                                             Msg.send (bio, MsgOk);
                                             ("Configuration complete.", NONE)))


@@ -1657,8 +1667,7 @@ fun slave () =
        val _ = print ("Slave server starting at " ^ now () ^ "\n")
 
        fun loop () =
        val _ = print ("Slave server starting at " ^ now () ^ "\n")
 
        fun loop () =

-           (Acl.read Config.aclFile;
-            case OpenSSL.accept sock of
+           (case OpenSSL.accept sock of

                 NONE => ()
               | SOME bio =>
                 let
                 NONE => ()
               | SOME bio =>
                 let


@@ -1803,16 +1812,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;