Be more cautious creating log directories
[hcoop/domtool2.git] / src / domain.sml
index 38993a2..0354944 100644 (file)
@@ -49,7 +49,7 @@ val your_pths = ref SS.empty
 fun your_paths () = !your_pths
 
 fun setUser user =
-    (usr := Config.testUser;
+    (usr := user;
      your_doms := Acl.class {user = getUser (),
                             class = "domain"};
      your_usrs := Acl.class {user = getUser (),
@@ -153,6 +153,13 @@ val _ = Env.type_one "node"
        Env.string
        validNode
 
+val _ = Env.registerFunction ("dns_node_to_node",
+                             fn [e] => SOME e
+                              | _ => NONE)
+
+val _ = Env.registerFunction ("mail_node_to_node",
+                             fn [e] => SOME e
+                              | _ => NONE)
 open Ast
 
 val dl = ErrorMsg.dummyLoc
@@ -169,14 +176,20 @@ val soaD = multiApp ((EVar "soa", dl),
                     [nsD, serialD, refD, retD, expD, minD])
 
 val masterD = (EApp ((EVar "internalMaster", dl),
-                    (EString Config.defaultNode, dl)),
+                    (EString Config.masterNode, dl)),
               dl)
 
+val slavesD = (EList (map (fn s => (EString s, dl)) Config.slaveNodes), dl)
+
+val _ = Defaults.registerDefault ("Mailbox",
+                                 (TBase "email", dl),
+                                 (fn () => (EString (getUser ()), dl)))
+
 val _ = Defaults.registerDefault ("DNS",
                                  (TBase "dnsKind", dl),
                                  (fn () => multiApp ((EVar "useDns", dl),
                                                      dl,
-                                                     [soaD, masterD, (EList [], dl)])))
+                                                     [soaD, masterD, slavesD])))
 
 val _ = Defaults.registerDefault ("TTL",
                                  (TBase "int", dl),
@@ -217,7 +230,13 @@ datatype master =
         ExternalMaster of string
        | InternalMaster of string
 
-val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (Env.string e)
+val ip = Env.string
+
+val _ = Env.registerFunction ("ip_of_node",
+                             fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
+                              | _ => NONE)
+
+val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
              | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
              | _ => NONE
 
@@ -470,7 +489,7 @@ val _ = Env.containerV_one "domain"
                                           TextIO.output (outf, "\" IN {\n\ttype ");
                                           TextIO.output (outf, kind);
                                           TextIO.output (outf, ";\n\tfile \"");
-                                          TextIO.output (outf, Config.Bind.zonePath);
+                                          TextIO.output (outf, Config.Bind.zonePath_real);
                                           TextIO.output (outf, "/");
                                           TextIO.output (outf, dom);
                                           TextIO.output (outf, ".zone\";\n");
@@ -478,7 +497,7 @@ val _ = Env.containerV_one "domain"
                                               "master" => TextIO.output (outf, "\tallow-update { none; };\n")
                                             | _ => (TextIO.output (outf, "\tmasters { ");
                                                     TextIO.output (outf, masterIp);
-                                                    TextIO.output (outf, " };\n"));
+                                                    TextIO.output (outf, "; };\n"));
                                           TextIO.output (outf, "};\n");
                                           TextIO.closeOut outf
                                       end
@@ -518,6 +537,35 @@ val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", C
                                            handle OS.SysErr _ => ())
                                        nodes))
 
+fun handleSite (site, files) =
+    let
+       
+    in
+       print ("New configuration for node " ^ site ^ "\n");
+       if site = Config.defaultNode then
+           Slave.handleChanges files
+       else let
+               val bio = OpenSSL.connect (valOf (!ssl_context),
+                                          nodeIp site
+                                          ^ ":"
+                                          ^ Int.toString Config.slavePort)
+           in
+               app (fn file => Msg.send (bio, MsgFile file)) files;
+               Msg.send (bio, MsgDoFiles);
+               case Msg.recv bio of
+                   NONE => print "Slave closed connection unexpectedly\n"
+                 | SOME m =>
+                   case m of
+                       MsgOk => print ("Slave " ^ site ^ " finished\n")
+                     | MsgError s => print ("Slave " ^ site
+                                            ^ " returned error: " ^
+                                            s ^ "\n")
+                     | _ => print ("Slave " ^ site
+                                   ^ " returned unexpected command\n");
+               OpenSSL.close bio
+           end
+    end
+
 val () = Env.registerPost (fn () =>
                              let
                                  val diffs = findAllDiffs ()
@@ -559,35 +607,6 @@ val () = Env.registerPost (fn () =>
                                                                  in
                                                                      SM.insert (changed, site, file :: ls)
                                                                  end) SM.empty diffs
-
-                                         fun handleSite (site, files) =
-                                             let
-                                                 
-                                             in
-                                                 print ("New configuration for node " ^ site ^ "\n");
-                                                 if site = Config.defaultNode then
-                                                     Slave.handleChanges files
-                                                 else let
-                                                         val bio = OpenSSL.connect (valOf (!ssl_context),
-                                                                                    nodeIp site
-                                                                                    ^ ":"
-                                                                                    ^ Int.toString Config.slavePort)
-                                                     in
-                                                         app (fn file => Msg.send (bio, MsgFile file)) files;
-                                                         Msg.send (bio, MsgDoFiles);
-                                                         case Msg.recv bio of
-                                                             NONE => print "Slave closed connection unexpectedly\n"
-                                                           | SOME m =>
-                                                             case m of
-                                                                 MsgOk => print ("Slave " ^ site ^ " finished\n")
-                                                               | MsgError s => print ("Slave " ^ site
-                                                                                      ^ " returned error: " ^
-                                                                                      s ^ "\n")
-                                                               | _ => print ("Slave " ^ site
-                                                                             ^ " returned unexpected command\n");
-                                                         OpenSSL.close bio
-                                                     end
-                                             end
                                      in
                                          SM.appi handleSite changed
                                      end;
@@ -595,4 +614,62 @@ val () = Env.registerPost (fn () =>
                                                     fn cl => "Temp file cleanup failed: " ^ cl))
                              end)
 
+fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
+                  orelse Acl.query {user = getUser (), class = "priv", value = priv}
+
+val _ = Env.type_one "dns_node"
+       Env.string
+       (fn node =>
+           List.exists (fn x => x = node) Config.dnsNodes_all
+           orelse (hasPriv "dns"
+                   andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
+
+val _ = Env.type_one "mail_node"
+       Env.string
+       (fn node =>
+           List.exists (fn x => x = node) Config.mailNodes_all
+           orelse (hasPriv "mail"
+                   andalso List.exists (fn x => x = node) Config.mailNodes_admin))
+
+fun rmdom dom =
+    let
+       val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+
+       fun doNode (node, _) =
+           let
+               val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+                                                file = node}
+               val dname = OS.Path.concat (dname, domPath)
+
+               val dir = Posix.FileSys.opendir dname
+
+               fun loop actions =
+                   case Posix.FileSys.readdir dir of
+                       NONE => actions
+                     | SOME fname => loop ({action = Slave.Delete,
+                                            domain = dom,
+                                            dir = dname,
+                                            file = OS.Path.joinDirFile {dir = dname,
+                                                                        file = fname}} :: actions)
+
+               val actions = loop []
+           in
+               Posix.FileSys.closedir dir;
+               handleSite (node, actions)
+           end
+               handle IO.Io _ => print ("Warning: IO error deleting domain " ^ dom ^ " on " ^ node ^ ".\n")
+
+       fun cleanupNode (node, _) =
+           let
+               val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+                                                file = node}
+               val dname = OS.Path.concat (dname, domPath)
+           in
+               ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+           end
+    in
+       app doNode Config.nodeIps;
+       app cleanupNode Config.nodeIps
+    end
+
 end