X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/e9f528ab975ac28c16b2c370e69206a48f584d78..c219fe5500b4294ba8dc0bce57b5c7d60b39065e:/src/domain.sml

diff --git a/src/domain.sml b/src/domain.sml
index ebd7a2b..d7b4052 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -48,8 +48,11 @@ fun your_groups () = !your_grps
 val your_pths = ref SS.empty
 fun your_paths () = !your_pths
 
+val your_ipss = ref SS.empty
+fun your_ips () = !your_ipss
+
 val world_readable = SS.addList (SS.empty, Config.worldReadable)
-val readable_pths = ref SS.empty
+val readable_pths = ref world_readable
 fun readable_paths () = !readable_pths
 
 fun setUser user =
@@ -66,7 +69,9 @@ fun setUser user =
 	your_grps := Acl.class {user = getUser (),
 				class = "group"};
 	your_pths := your_paths;
-	readable_pths := SS.union (your_paths, world_readable)
+	readable_pths := SS.union (your_paths, world_readable);
+	your_ipss := Acl.class {user = getUser (),
+				class = "ip"}
     end
 
 fun validIp s =
@@ -75,6 +80,36 @@ fun validIp s =
 	n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
       | _ => false
 
+fun isHexDigit ch = Char.isDigit ch orelse (ord ch >= ord #"a" andalso ord ch <= ord #"f")
+
+fun validIpv6 s =
+    let
+	val fields = String.fields (fn ch => ch = #":") s
+
+	val empties = foldl (fn ("", n) => n + 1
+			      | (_, n) => n) 0 fields
+
+	fun noIpv4 maxLen =
+	    length fields >= 2
+	    andalso length fields <= maxLen
+	    andalso empties <= 1
+	    andalso List.all (fn "" => true
+			       | s => size s <= 4
+				      andalso CharVector.all isHexDigit s) fields
+
+	fun hasIpv4 () =
+	    length fields > 0
+	    andalso
+	    let
+		val maybeIpv4 = List.last fields
+		val theRest = List.take (fields, length fields - 1)
+	    in
+		validIp maybeIpv4 andalso noIpv4 6
+	    end
+    in
+	noIpv4 8 orelse hasIpv4 ()
+    end
+
 fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
 
 fun validHost s =
@@ -97,6 +132,7 @@ fun checkPath paths path =
     andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (paths ())
 val yourPath = checkPath your_paths
 val readablePath = checkPath readable_paths
+fun yourIp s = SS.member (your_ips (), s)
 
 fun yourDomainHost s =
     yourDomain s
@@ -131,12 +167,16 @@ val _ = Env.type_one "no_spaces"
 val _ = Env.type_one "no_newlines"
 		     Env.string
 		     (CharVector.all (fn ch => Char.isPrint ch andalso ch <> #"\n" andalso ch <> #"\r"
-					       andalso ch <> #"\"" andalso ch <> #"'"))
+					       andalso ch <> #"\""))
 
 val _ = Env.type_one "ip"
 	Env.string
 	validIp
 
+val _ = Env.type_one "ipv6"
+	Env.string
+	validIpv6
+
 val _ = Env.type_one "host"
 	Env.string
 	validHost
@@ -177,10 +217,18 @@ val _ = Env.type_one "readable_path"
 	Env.string
 	readablePath
 
+val _ = Env.type_one "your_ip"
+	Env.string
+	yourIp
+
 val _ = Env.type_one "node"
 	Env.string
 	validNode
 
+val _ = Env.registerFunction ("your_ip_to_ip",
+			      fn [e] => SOME e
+			       | _ => NONE)
+
 val _ = Env.registerFunction ("dns_node_to_node",
 			      fn [e] => SOME e
 			       | _ => NONE)
@@ -188,10 +236,22 @@ val _ = Env.registerFunction ("dns_node_to_node",
 val _ = Env.registerFunction ("mail_node_to_node",
 			      fn [e] => SOME e
 			       | _ => NONE)
+
+
 open Ast
 
 val dl = ErrorMsg.dummyLoc
 
+val _ = Env.registerFunction ("end_in_slash",
+			      fn [(EString "", _)] => SOME (EString "/", dl)
+			       | [(EString s, _)] =>
+				 SOME (EString (if String.sub (s, size s - 1) = #"/" then
+						    s
+						else
+						    s ^ "/"), dl)
+			       | _ => NONE)
+
+
 val nsD = (EString Config.defaultNs, dl)
 val serialD = (EVar "serialAuto", dl)
 val refD = (EInt Config.defaultRefresh, dl)
@@ -431,7 +491,7 @@ fun findDiffs (prefixes, site, dom, acts) =
 			    loopReal acts
 			else
 			    loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
-		    else if List.exists (fn prefix => String.isPrefix prefix realPath) prefixes then
+		    else if List.exists (fn prefix => String.isPrefix prefix real) prefixes then
 			loopReal ((site, dom, realPath, Delete' real) :: acts)
 		    else
 			loopReal acts
@@ -585,7 +645,10 @@ val _ = Env.containerV_one "domain"
 								write "\t};\n")
 						 | _ => (write "\tmasters { ";
 							 write masterIp;
-							 write "; };\n");
+							 write "; };\n";
+							 write "// Updated: ";
+							 write (Time.toString (Time.now ()));
+							 write "\n");
 					       write "};\n";
 					       close ()
 					   end
@@ -659,13 +722,16 @@ fun handleSite (site, files) =
 
 val () = Env.registerPost (fn () =>
 			      let
-				  val prefixes = List.map (fn dom =>
-							      let
-								  val pieces = String.tokens (fn ch => ch = #".") dom
-								  val path = String.concatWith "/" (rev pieces)
-							      in
-								  Config.resultRoot ^ "/" ^ path ^ "/"
-							      end) (!seenDomains)
+				  val prefixes = List.concat
+						     (List.map (fn dom =>
+								   let
+								       val pieces = String.tokens (fn ch => ch = #".") dom
+								       val path = String.concatWith "/" (rev pieces)
+								   in
+								       List.map (fn node =>
+										    Config.resultRoot ^ "/" ^ node ^ "/" ^ path ^ "/")
+										nodes
+								   end) (!seenDomains))
 								  
 				  val diffs = findAllDiffs prefixes
 
@@ -877,7 +943,7 @@ fun considerAll ds {node, domain} =
 				     case d of
 					 Filename {filename, heading, showEmpty} =>
 					 if fname = filename then
-					     entries := readFile showEmpty ("\n" :: line :: ":\n" :: heading :: line :: !entries)
+					     entries := readFile showEmpty ("\n" :: line :: "\n" :: heading :: line :: !entries)
 					 else
 					     ()
 				       | Extension {extension, heading} =>
@@ -888,7 +954,7 @@ fun considerAll ds {node, domain} =
 						 NONE => ()
 					       | SOME extension' =>
 						 if extension' = extension then
-						     entries := readFile true ("\n" :: line :: ":\n" :: heading base :: line :: !entries)
+						     entries := readFile true ("\n" :: line :: "\n" :: heading base :: line :: !entries)
 						 else
 						     ()
 					 end
@@ -904,7 +970,7 @@ fun considerAll ds {node, domain} =
     end
 
 val () = registerDescriber (considerAll [Filename {filename = "soa",
-						   heading = "DNS SOA",
+						   heading = "DNS SOA:",
 						   showEmpty = false}])
 
 val () = Env.registerAction ("domainHost",