E-mail aliases

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

diff --git a/src/domain.sml b/src/domain.sml
index 32b7ecf..99152ea 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -20,6 +20,24 @@
 
 structure Domain :> DOMAIN = struct
 
+fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
+
+fun validHost s =
+    size s > 0 andalso size s < 20
+    andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
+
+fun validDomain s =
+    size s > 0 andalso size s < 100
+    andalso List.all validHost (String.fields (fn ch => ch = #".") s)
+
+val _ = Env.type_one "host"
+       Env.string
+       validHost
+
+val _ = Env.type_one "domain"
+       Env.string
+       validDomain
+
 open Ast
 
 val befores = ref (fn (_ : string) => ())
@@ -65,15 +83,14 @@ fun getPath domain =
                                  elems
                              end) [] toks
     in
-       String.concatWith "/" (Config.configRoot :: rev elems)
+       String.concatWith "/" (Config.configRoot :: rev ("" :: elems))
     end
 
-val _ = Env.registerContainer ("domain",
-                           fn (_, [(EString dom, _)]) => (current := dom;
-                                                          currentPath := getPath dom;
-                                                          !befores dom;
-                                                          StringMap.empty)
-                            | _ => Env.badArgs "domain",
-                           fn () => !afters (!current))
+val _ = Env.container_one "domain"
+                         ("domain", Env.string)
+                         (fn dom => (current := dom;
+                                     currentPath := getPath dom;
+                                     !befores dom),
+                          fn () => !afters (!current))
 
 end