X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/2e96b9d42f6d2619f961c753ac3bbc9ba57c5147..b25161c70648676e61db4eead37a84f460182576:/src/domain.sml

diff --git a/src/domain.sml b/src/domain.sml
index 4e38a98..ed26bcd 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -191,6 +191,10 @@ val masterD = (EApp ((EVar "internalMaster", dl),
 
 val slavesD = (EList (map (fn s => (EString s, dl)) Config.slaveNodes), dl)
 
+val _ = Defaults.registerDefault ("Aliases",
+				  (TList (TBase "your_domain", dl), dl),
+				  (fn () => (EList [], dl)))
+
 val _ = Defaults.registerDefault ("Mailbox",
 				  (TBase "email", dl),
 				  (fn () => (EString (getUser ()), dl)))
@@ -309,14 +313,34 @@ fun resetLocal () = !locals ()
 
 val current = ref ""
 val currentPath = ref (fn (_ : string) => "")
+val currentPathAli = ref (fn (_ : string, _ : string) => "")
 
 val scratch = ref ""
 
 fun currentDomain () = !current
 
+val currentsAli = ref ([] : string list)
+
+fun currentAliasDomains () = !currentsAli
+fun currentDomains () = currentDomain () :: currentAliasDomains ()
+
 fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
 			       TextIO.openOut (!currentPath node ^ name))
 
+type files = {write : string -> unit,
+	      writeDom : unit -> unit,
+	      close : unit -> unit}
+
+fun domainsFile {node, name} =
+    let
+	val doms = currentDomains ()
+	val files = map (fn dom => (dom, TextIO.openOut (!currentPathAli (dom, node) ^ name))) doms
+    in
+	{write = fn s => app (fn (_, outf) => TextIO.output (outf, s)) files,
+	 writeDom = fn () => app (fn (dom, outf) => TextIO.output (outf, dom)) files,
+	 close = fn () => app (fn (_, outf) => TextIO.closeOut outf) files}
+    end
+
 fun getPath domain =
     let
 	val toks = String.fields (fn ch => ch = #".") domain
@@ -480,58 +504,67 @@ val _ = Env.containerV_one "domain"
 			       let
 				   val kind = Env.env dnsKind (evs, "DNS")
 				   val ttl = Env.env Env.int (evs, "TTL")
+				   val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
 
 				   val path = getPath dom
 
 				   val () = (current := dom;
-					     currentPath := (fn site => path (Config.tmpDir, site)))
+					     currentsAli := Slave.remove (Slave.removeDups aliases, dom);
+					     currentPath := (fn site => path (Config.tmpDir, site));
+					     currentPathAli := (fn (dom, site) => getPath dom (Config.tmpDir, site)))
 
 				   fun saveSoa (kind, soa : soa) node =
 				       let
-					   val outf = domainFile {node = node, name = "soa"}
+					   val {write, writeDom, close} = domainsFile {node = node, name = "soa"}
 				       in
-					   TextIO.output (outf, kind);
-					   TextIO.output (outf, "\n");
-					   TextIO.output (outf, Int.toString ttl);
-					   TextIO.output (outf, "\n");
-					   TextIO.output (outf, #ns soa);
-					   TextIO.output (outf, "\n");
+					   write kind;
+					   write "\n";
+					   write (Int.toString ttl);
+					   write "\n";
+					   write (#ns soa);
+					   write "\n";
 					   case #serial soa of
 					       NONE => ()
-					     | SOME n => TextIO.output (outf, Int.toString n);
-					   TextIO.output (outf, "\n");
-					   TextIO.output (outf, Int.toString (#ref soa));
-					   TextIO.output (outf, "\n");
-					   TextIO.output (outf, Int.toString (#ret soa));
-					   TextIO.output (outf, "\n");
-					   TextIO.output (outf, Int.toString (#exp soa));
-					   TextIO.output (outf, "\n");
-					   TextIO.output (outf, Int.toString (#min soa));
-					   TextIO.output (outf, "\n");
-					   TextIO.closeOut outf
+					     | SOME n => write (Int.toString n);
+					   write "\n";
+					   write (Int.toString (#ref soa));
+					   write "\n";
+					   write (Int.toString (#ret soa));
+					   write "\n";
+					   write (Int.toString (#exp soa));
+					   write "\n";
+					   write (Int.toString (#min soa));
+					   write "\n";
+					   close ()
 				       end
 
-				   fun saveNamed (kind, soa : soa, masterIp) node =
-				       let
-					   val outf = domainFile {node = node, name = "named.conf"}
-				       in
-					   TextIO.output (outf, "\nzone \"");
-					   TextIO.output (outf, dom);
-					   TextIO.output (outf, "\" IN {\n\ttype ");
-					   TextIO.output (outf, kind);
-					   TextIO.output (outf, ";\n\tfile \"");
-					   TextIO.output (outf, Config.Bind.zonePath_real);
-					   TextIO.output (outf, "/");
-					   TextIO.output (outf, dom);
-					   TextIO.output (outf, ".zone\";\n");
-					   case kind of
-					       "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.closeOut outf
-				       end
+				   fun saveNamed (kind, soa : soa, masterIp, slaveIps) node =
+				       if dom = "localhost" then
+					   ()
+				       else let
+					       val {write, writeDom, close} = domainsFile {node = node, name = "named.conf"}
+					   in
+					       write "\nzone \"";
+					       writeDom ();
+					       write "\" {\n\ttype ";
+					       write kind;
+					       write ";\n\tfile \"";
+					       write Config.Bind.zonePath_real;
+					       write "/";
+					       writeDom ();
+					       write ".zone\";\n";
+					       case kind of
+						   "master" => (write "\tallow-transfer {\n";
+								app (fn ip => (write "\t\t";
+									       write ip;
+									       write ";\n")) slaveIps;
+								write "\t};\n")
+						 | _ => (write "\tmasters { ";
+							 write masterIp;
+							 write "; };\n");
+					       write "};\n";
+					       close ()
+					   end
 			       in
 				   case kind of
 				       NoDns => masterNode := NONE
@@ -539,19 +572,21 @@ val _ = Env.containerV_one "domain"
 				       let
 					   val masterIp =
 					       case #master dns of
-						   InternalMaster node => valOf (SM.find (nodeMap, node))
+						   InternalMaster node => nodeIp node
 						 | ExternalMaster ip => ip
+
+					   val slaveIps = map nodeIp (#slaves dns)
 				       in
 					   app (saveSoa ("slave", #soa dns)) (#slaves dns);
-					   app (saveNamed ("slave", #soa dns, masterIp)) (#slaves dns);
+					   app (saveNamed ("slave", #soa dns, masterIp, slaveIps)) (#slaves dns);
 					   case #master dns of
 					       InternalMaster node =>
 					       (masterNode := SOME node;
 						saveSoa ("master", #soa dns) node;
-						saveNamed ("master", #soa dns, masterIp) node)
-					     | _ => masterNode := NONE;
-					   !befores dom
-				       end
+						saveNamed ("master", #soa dns, masterIp, slaveIps) node)
+					     | _ => masterNode := NONE
+				       end;
+				   !befores dom
 			       end,
 			    fn () => !afters (!current))
 
@@ -732,4 +767,9 @@ fun rmdom doms =
 	app cleanupNode Config.nodeIps
     end
 
+fun homedirOf uname =
+    Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
+
+fun homedir () = homedirOf (getUser ())
+
 end