E-mail aliases

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

diff --git a/src/domain.sml b/src/domain.sml
index e38ea4a..99152ea 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -14,12 +14,30 @@
  * You should have received a copy of the GNU General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
-*)
+ *)
 
 (* Domain-related primitive actions *)
 
 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) => ())
@@ -40,12 +58,39 @@ fun registerAfter f =
     end
 
 val current = ref ""
+val currentPath = ref ""
+
+fun currentDomain () = !current
+
+fun domainFile name = TextIO.openOut (!currentPath ^ name)
+
+fun getPath domain =
+    let
+       val toks = String.fields (fn ch => ch = #".") domain
+
+       val elems = foldr (fn (piece, elems) =>
+                             let
+                                 val elems = piece :: elems
+                                 val path = String.concatWith "/" (Config.configRoot :: rev elems)
+                             in
+                                 (if Posix.FileSys.ST.isDir
+                                         (Posix.FileSys.stat path) then
+                                      ()
+                                  else
+                                      (OS.FileSys.remove path;
+                                       OS.FileSys.mkDir path))
+                                 handle OS.SysErr _ => OS.FileSys.mkDir path;
+                                 elems
+                             end) [] toks
+    in
+       String.concatWith "/" (Config.configRoot :: rev ("" :: elems))
+    end
 
-val _ = Env.registerContainer ("domain",
-                           fn (_, [(EString dom, _)]) => (current := 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