X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/c219fe5500b4294ba8dc0bce57b5c7d60b39065e..cfedb9220fc5a849df6d5d85cc929d1f72ac0326:/src/plugins/bind.sml

diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml
index 3d79cbf..46bd086 100644
--- a/src/plugins/bind.sml
+++ b/src/plugins/bind.sml
@@ -44,25 +44,39 @@ val _ = Domain.registerAfter
 
 val dl = ErrorMsg.dummyLoc
 
+datatype host =
+	 Literal of string
+       | Wildcard
+       | Default
+
 datatype dns_record =
-	 A of string * string
-       | CNAME of string * string
+	 A of host * string
+       | CNAME of host * string
        | MX of int * string
        | NS of string
-       | DefaultA of string
-       | AAAA of string * string
-       | DefaultAAAA of string
-       | TXT of string * string
-       | DefaultTXT of string
+       | AAAA of host * string
+       | TXT of host * string
        | AFSDB of string
        | SRV of string * int * int * int * string
 
+fun hostS (Literal s) = s ^ "."
+  | hostS Wildcard = "*."
+  | hostS Default = ""
+
+val host = fn (EApp ((EVar "literal", _), e), _) =>
+	      Option.map Literal (Env.string e)
+	    | (EVar "wildcard", _) =>
+	      SOME Wildcard
+	    | (EVar "default", _) =>
+	      SOME Default
+	    | _ => NONE
+
 val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
-		(case (Env.string e1, Domain.ip e2) of
+		(case (host e1, Domain.ip e2) of
 		     (SOME v1, SOME v2) => SOME (A (v1, v2))
 		   | _ => NONE)
 	      | (EApp ((EApp ((EVar "dnsCNAME", _), e1), _), e2), _) =>
-		(case (Env.string e1, Env.string e2) of
+		(case (host e1, Env.string e2) of
 		     (SOME v1, SOME v2) => SOME (CNAME (v1, v2))
 		   | _ => NONE)
 	      | (EApp ((EApp ((EVar "dnsMX", _), e1), _), e2), _) =>
@@ -71,20 +85,14 @@ val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
 		   | _ => NONE)
 	      | (EApp ((EVar "dnsNS", _), e), _) =>
 		Option.map NS (Env.string e)
-	      | (EApp ((EVar "dnsDefaultA", _), e), _) =>
-		Option.map DefaultA (Domain.ip e)
 	      | (EApp ((EApp ((EVar "dnsAAAA", _), e1), _), e2), _) =>
-		(case (Env.string e1, Env.string e2) of
+		(case (host e1, Env.string e2) of
 		     (SOME v1, SOME v2) => SOME (AAAA (v1, v2))
 		   | _ => NONE)
-	      | (EApp ((EVar "dnsDefaultAAAA", _), e), _) =>
-		Option.map DefaultAAAA (Env.string e)
 	      | (EApp ((EApp ((EVar "dnsTXT", _), e1), _), e2), _) =>
-		(case (Env.string e1, Env.string e2) of
+		(case (host e1, Env.string e2) of
 		     (SOME v1, SOME v2) => SOME (TXT (v1, v2))
 		   | _ => NONE)
-	      | (EApp ((EVar "dnsDefaultTXT", _), e), _) =>
-		Option.map DefaultTXT (Env.string e)
 	      | (EApp ((EVar "dnsAFSDB", _), e), _) =>
 		Option.map AFSDB (Env.string e)
 	      | (EApp ((EApp ((EApp ((EApp ((EApp ((EVar "dnsSRV", _), e1), _), e2), _), e3), _), e4), _), e5), _) =>
@@ -104,22 +112,14 @@ fun writeRecord (evs, r) =
 	    val ttl = Env.env Env.int (evs, "TTL")
 	in
 	    case r of
-		A (from, to) => (write from;
-				 write ".";
+		A (from, to) => (write (hostS from);
 				 writeDom ();
 				 write ".\t";
 				 write (Int.toString ttl);
 				 write "\tIN\tA\t";
 				 write to;
 				 write "\n")
-	      | DefaultA to => (writeDom ();
-				write ".\t";
-				write (Int.toString ttl);
-				write "\tIN\tA\t";
-				write to;
-				write "\n")
-	      | CNAME (from, to) => (write from;
-				     write ".";
+	      | CNAME (from, to) => (write (hostS from);
 				     writeDom ();
 				     write ".\t";
 				     write (Int.toString ttl);
@@ -140,34 +140,20 @@ fun writeRecord (evs, r) =
 			    write "\tIN\tNS\t";
 			    write host;
 			    write ".\n")
-	      | AAAA (from, to) => (write from;
-				    write ".";
+	      | AAAA (from, to) => (write (hostS from);
 				    writeDom ();
 				    write ".\t";
 				    write (Int.toString ttl);
 				    write "\tIN\tAAAA\t";
 				    write to;
 				    write "\n")
-	      | DefaultAAAA to => (writeDom ();
-				   write ".\t";
-				   write (Int.toString ttl);
-				   write "\tIN\tAAAA\t";
-				   write to;
-				   write "\n")
-	      | TXT (from, to) => (write from;
-				   write ".";
+	      | TXT (from, to) => (write (hostS from);
 				   writeDom ();
 				   write ".\t";
 				   write (Int.toString ttl);
 				   write "\tIN\tTXT\t\"";
 				   write (String.translate (fn #"\"" => "\\\"" | ch => str ch) to);
 				   write "\"\n")
-	      | DefaultTXT to => (writeDom ();
-				  write ".\t";
-				  write (Int.toString ttl);
-				  write "\tIN\tTXT\t\"";
-				  write (String.translate (fn #"\"" => "\\\"" | ch => str ch) to);
-				  write "\"\n")
 	      | AFSDB host => (writeDom ();
 			       write ".\t";
 			       write (Int.toString ttl);