X-Git-Url: http://git.hcoop.net/hcoop/zz_old/domtool.git/blobdiff_plain/05060d1654525f24e3b9d2279182048a503f67bb..d1c1f370b7a4a45f6d9dbb8972352da4aa202e0d:/src/util.sml

diff --git a/src/util.sml b/src/util.sml
index 2962f91..18b2ec2 100644
--- a/src/util.sml
+++ b/src/util.sml
@@ -46,6 +46,16 @@ struct
 	    loop init
 	end
 
+    fun ioOptLoopFold next body init =
+	let
+	    fun loop state =
+		case next () of
+		    NONE => state
+		  | SOME v => loop (body (v, state))
+	in
+	    loop init
+	end
+
     fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
 
     fun isInt s = Int.fromString s <> NONE
@@ -58,27 +68,42 @@ struct
     fun chop s = String.substring (s, 0, size s - 1)
 
     fun validHost s =
-	size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s)
-					       
+	size s > 0 andalso size s < 20 andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
+
+    fun validVhostFilename s =
+	case String.fields (fn ch => ch = #".") s of
+	    [s] => validHost s
+	  | [s, "ssl"] => validHost s
+	  | _ => false
+		       
     fun validDomain s =
 	size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s)
 
+    fun validDomainId s =
+	case String.fields (fn ch => ch = #"_") s of
+	    [_] => validDomain s
+	  | [host, rest] =>
+	    (validHost host andalso case String.tokens (fn ch => ch = #".") rest of
+		 "ssl" :: rest => List.all validHost rest
+	       | _ => false)
+	  | _ => false
+
     fun validUser s =
-	size s > 0 andalso size s < 20 andalso List.all
+	size s > 0 andalso size s < 50 andalso CharVector.all
 						   (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
-						   (String.explode s)
+						   s
 
     fun validEmailUser s =
-	size s > 0 andalso size s < 20 andalso List.all
+	size s > 0 andalso size s < 50 andalso CharVector.all
 						   (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
-						   (String.explode s)
+						   s
     fun validEmail s =
 	(case String.fields (fn ch => ch = #"@") s of
 	     [user, host] => validEmailUser user andalso validDomain host
 	   | _ => false)
 
     fun isTmp s =
-	List.exists (fn ch => ch = #"#" orelse ch = #"~") (String.explode s)
+	CharVector.exists (fn ch => ch = #"#" orelse ch = #"~") s
 
     fun validIp s =
 	(case map Int.fromString (String.fields (fn ch => ch = #".") s) of
@@ -123,5 +148,103 @@ struct
 		     v
 		 else
 		     "")
+
+    fun enrichSetFromFile (fname, set) =
+	let
+	    open TextIO
+	    val uid = Posix.ProcEnv.wordToUid (SysWord.fromInt Config.uid)
+	in
+	    if Posix.FileSys.access (fname, []) then
+		(if Posix.FileSys.ST.uid (Posix.FileSys.stat fname) = uid then
+		     let
+			 val vf = openIn fname
+				  
+			 fun loop set =
+			     let
+				 val line = inputLine vf
+			     in
+				 case line of
+				     NONE => set
+				   | SOME "CLEAR\n" => loop StringSet.empty
+				   | SOME line =>
+				     (case String.tokens Char.isSpace line of
+					  [item] => loop (StringSet.add (set, item))
+					| _ => loop set)
+			     end
+		     in
+			 loop set
+			 before TextIO.closeIn vf
+		     end
+		 else
+		     (print (fname ^ ": wrong owner to be used");
+		      set))
+	    else
+		set
+	end
+
+    fun enrichMapFromFile (fname, map) =
+	let
+	    open TextIO
+	    val uid = Posix.ProcEnv.wordToUid (SysWord.fromInt Config.uid)
+	in
+	    if Posix.FileSys.access (fname, []) then
+		(if Posix.FileSys.ST.uid (Posix.FileSys.stat fname) = uid then
+		     let
+			 val vf = openIn fname
+				  
+			 fun loop map =
+			     let
+				 val line = inputLine vf
+			     in
+				 case line of
+				     NONE => map
+				   | SOME "CLEAR\n" => loop StringMap.empty
+				   | SOME line =>
+				     (case String.tokens Char.isSpace line of
+					  [key, value] => loop (StringMap.insert (map, key, value))
+					| [] => loop map
+					| _ => (print (fname ^ ": invalid line: " ^ line);
+					       loop map))
+			     end
+		     in
+			 loop map
+			 before TextIO.closeIn vf
+		     end
+		 else
+		     (print (fname ^ ": wrong owner to be used");
+		      map))
+	    else
+		map
+	end
+
+    fun merge (L1 : ('a * int) list, L2 : ('a * int) list) acc =
+	case (L1, L2) of
+	    (_, []) => List.revAppend (acc, L1)
+	  | ([], _) => List.revAppend (acc, L2)
+	  | (n1::t1, n2::t2) =>
+	    if #2 n1 > #2 n2 then
+		merge (t1, L2) (n1 :: acc)
+	    else
+		merge (L1, t2) (n2 :: acc)
+
+    fun split n L acc =
+	if n <= 0 then
+	    (acc, L)
+	else
+	    case L of
+		[] => (acc, [])
+	      | h::t => split (n-1) t (h::acc)
+
+    fun mergeSort L =
+	case L of
+	    [] => L
+	  | [a] => L
+	  | _ =>
+	    let
+		val mid = length L div 2
+		val (L1, L2) = split mid L []
+	    in
+		merge (mergeSort L1, mergeSort L2) []
+	    end
 end