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

diff --git a/src/plugins/alias.sml b/src/plugins/alias.sml
index 9449f2b..2dbb44e 100644
--- a/src/plugins/alias.sml
+++ b/src/plugins/alias.sml
@@ -22,22 +22,46 @@ 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
+	fun 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
+
+fun reopenAliasesD () = (SM.app (fn {close, ...} => close ()) (!aliasesD);
+			 aliasesD := openInAll "aliases.default")
 
 val _ = Domain.registerBefore
-	    (fn _ => (aliases := SOME (Domain.domainFile "aliases");
-		      aliasesD := SOME (Domain.domainFile "aliases.default")))
+	    (fn _ => (aliases := openInAll "aliases.base";
+		      reopenAliasesD ()))
 	
 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 +88,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 +116,37 @@ 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 => (reopenAliasesD ();
+			writeD "*@";
+			writeDomD ();
+			writeD ": ";
+			writeTarget (writeD, t);
+			writeD "\n")
+    end
+			
+val _ = Env.actionV_two "aliasPrim"
+			("from", source, "to", target)
+			writeSource
 
 end