Fix file paths for recursive rmdom

[hcoop/domtool2.git] / src / plugins / alias.sml

diff --git a/src/plugins/alias.sml b/src/plugins/alias.sml
index 9449f2b..43e109f 100644 (file)
--- a/src/plugins/alias.sml
+++ b/src/plugins/alias.sml
@@ -22,22 +22,41 @@ 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 : TextIO.outstream 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 : TextIO.outstream 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 => TextIO.output (file, s)) files
+    end
+
+fun writeD nodes =
+    let
+       val files = map (fn node => aliasesDF node) nodes
+    in
+       fn s => app (fn file => TextIO.output (file, s)) files
+    end
+
+fun openInAll base = foldl (fn (node, r) =>
+                              SM.insert (r,
+                                         node,
+                                         Domain.domainFile {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 TextIO.closeOut (!aliases);
+                 SM.app TextIO.closeOut (!aliasesD)))
 
 fun validEmailUser s =
     size s > 0 andalso size s < 50
@@ -94,34 +113,41 @@ 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 = write nodes
+       val writeD = 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 "@";
+                      write (Domain.currentDomain ());
+                      write ": ";
+                      writeTarget (write, t);
+                      write "\n")
+         | Default => (write "*@";
+                       write (Domain.currentDomain ());
+                       write ": ";
+                       writeTarget (write, t);
+                       write "\n")
+         | CatchAll => (writeD "*@";
+                        writeD (Domain.currentDomain ());
+                        writeD ": ";
+                        writeTarget (writeD, t);
+                        writeD "\n")
+    end
+                       
+val _ = Env.actionV_two "aliasPrim"
+                       ("from", source, "to", target)
+                       writeSource
 
 end