No more catch-all aliases, and default aliases go to a separate file
[hcoop/domtool2.git] / src / plugins / alias.sml
index 9449f2b..b96d57d 100644 (file)
@@ -22,22 +22,43 @@ structure Alias :> ALIAS = struct
 
 open Ast
 
-val aliases : TextIO.outstream option ref = ref NONE
-fun aliasesF () = valOf (!aliases)
+structure SM = DataStructures.StringMap
 
-val aliasesD : TextIO.outstream option ref = ref NONE
-fun aliasesDF () = valOf (!aliasesD)
+val aliases : Domain.files SM.map ref = ref SM.empty
+fun aliasesF node = valOf (SM.find (!aliases, node))
 
-fun write s = TextIO.output (aliasesF (), s)
-fun writeD s = TextIO.output (aliasesDF (), s)
+val aliasesD : Domain.files SM.map ref = ref SM.empty
+fun aliasesDF node = valOf (SM.find (!aliasesD, node))
+
+fun write nodes =
+    let
+       val files = map (fn node => aliasesF node) nodes
+    in
+       (fn s => app (fn file => #write file s) files,
+        fn () => app (fn file => #writeDom file ()) files)
+    end
+
+fun writeD nodes =
+    let
+       val files = map (fn node => aliasesDF node) nodes
+    in
+       (fn s => app (fn file => #write file s) files,
+        fn () => app (fn file => #writeDom file ()) files)
+    end
+
+fun openInAll base = foldl (fn (node, r) =>
+                              SM.insert (r,
+                                         node,
+                                         Domain.domainsFile {node = node, name = base}))
+                          SM.empty Domain.nodes
 
 val _ = Domain.registerBefore
-           (fn _ => (aliases := SOME (Domain.domainFile "aliases");
-                     aliasesD := SOME (Domain.domainFile "aliases.default")))
+           (fn _ => (aliases := openInAll "aliases";
+                     aliasesD := openInAll "aliases.default"))
        
 val _ = Domain.registerAfter
-       (fn _ => (TextIO.closeOut (aliasesF ());
-                 TextIO.closeOut (aliasesDF ())))
+       (fn _ => (SM.app (fn file => #close file ()) (!aliases);
+                 SM.app (fn file => #close file ()) (!aliasesD)))
 
 fun validEmailUser s =
     size s > 0 andalso size s < 50
@@ -64,12 +85,10 @@ val _ = Env.type_one "email"
 datatype aliasSource =
         User of string
        | Default
-       | CatchAll
 
 val source = fn (EApp ((EVar "userSource", _), e), _) =>
                Option.map User (Env.string e)
              | (EVar "defaultSource", _) => SOME Default
-             | (EVar "catchAllSource", _) => SOME CatchAll
              | _ => NONE
 
 datatype aliasTarget =
@@ -94,34 +113,36 @@ fun localhostify s =
            s
     end
 
-fun writeTarget (outf, t) =
-    case t of
-       Address s => TextIO.output (outf, localhostify s)
-      | Addresses [] => TextIO.output (outf, "!")
-      | Addresses ss => TextIO.output (outf, String.concatWith "," (map localhostify ss))
-      | Drop => TextIO.output (outf, "!")
-
-fun writeSource (s, t) =
-    case s of
-       User s => (write s;
-                  write "@";
-                  write (Domain.currentDomain ());
-                  write ": ";
-                  writeTarget (aliasesF (), t);
-                  write "\n")
-      | Default => (write "*@";
-                   write (Domain.currentDomain ());
-                   write ": ";
-                   writeTarget (aliasesF (), t);
-                   write "\n")
-      | CatchAll => (writeD "*@";
-                    writeD (Domain.currentDomain ());
-                    writeD ": ";
-                    writeTarget (aliasesDF (), t);
-                    writeD "\n")
-
-val _ = Env.action_two "aliasPrim"
-                      ("from", source, "to", target)
-                      writeSource
+fun writeSource (env, s, t) =
+    let
+       val nodes = Env.env (Env.list Env.string) (env, "MailNodes")
+
+       val (write, writeDom) = write nodes
+       val (writeD, writeDomD) = writeD nodes
+
+       fun writeTarget (writer, t) =
+           case t of
+               Address s => writer (localhostify s)
+             | Addresses [] => writer "!"
+             | Addresses ss => writer (String.concatWith "," (map localhostify ss))
+             | Drop => writer "!"
+    in
+       case s of
+           User s => (write s;
+                      write "@";
+                      writeDom ();
+                      write ": ";
+                      writeTarget (write, t);
+                      write "\n")
+         | Default => (writeD "*@";
+                       writeDomD ();
+                       writeD ": ";
+                       writeTarget (writeD, t);
+                       writeD "\n")
+    end
+                       
+val _ = Env.actionV_two "aliasPrim"
+                       ("from", source, "to", target)
+                       writeSource
 
 end