X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/d612d62cd04b713bb1057fd2e666365704aaf3d6..2ed6d0e50d89234c3d63c3707e855c922bd49358:/src/plugins/alias.sml

diff --git a/src/plugins/alias.sml b/src/plugins/alias.sml
index 9449f2b..43e109f 100644
--- 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