bind_patterns

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

diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml
index 3d79cbf..46bd086 100644 (file)
--- 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);