Add IPv6 DNS mappings

diff --git a/lib/bind.dtl b/lib/bind.dtl
index 4f2c3c8..9cbc2fb 100644 (file)
--- a/lib/bind.dtl
+++ b/lib/bind.dtl
@@ -3,10 +3,12 @@
 extern type dnsRecord;
 
 extern val dnsA : host -> ip -> dnsRecord;
+extern val dnsAAAA : host -> ipv6 -> dnsRecord;
 extern val dnsCNAME : host -> domain -> dnsRecord;
 extern val dnsMX : int -> domain -> dnsRecord;
 extern val dnsNS : domain -> dnsRecord;
 
 extern val dnsDefaultA : ip -> dnsRecord;
+extern val dnsDefaultAAAA : ipv6 -> dnsRecord;
 
 extern val dns : dnsRecord -> [Domain] {TTL : int};

diff --git a/lib/domain.dtl b/lib/domain.dtl
index 3d9b088..8111c62 100644 (file)
--- a/lib/domain.dtl
+++ b/lib/domain.dtl
@@ -8,6 +8,8 @@ extern type no_newlines;
 
 extern type ip;
 {{An IP address}}
+extern type ipv6;
+{{An IPv6 address}}
 
 extern type your_ip;
 extern val your_ip_to_ip : your_ip -> ip;

diff --git a/lib/easy_domain.dtl b/lib/easy_domain.dtl
index 9934be4..8491af0 100644 (file)
--- a/lib/easy_domain.dtl
+++ b/lib/easy_domain.dtl
@@ -74,6 +74,8 @@ val dom =
 
 val nameserver = \host -> dns (dnsNS host);
 val dnsIP = \from -> \to -> dns (dnsA from to);
+val dnsIPv6 = \from -> \to -> dns (dnsAAAA from to);
 val dnsMail = \num -> \host -> dns (dnsMX num host);
 val dnsAlias = \from -> \to -> dns (dnsCNAME from to);
 val dnsDefault = \to -> dns (dnsDefaultA to);
+val dnsDefaultv6 = \to -> dns (dnsDefaultAAAA to);

diff --git a/src/domain.sml b/src/domain.sml
index 94eb077..8384f85 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -80,6 +80,36 @@ fun validIp s =
        n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
       | _ => false
 
+fun isHexDigit ch = Char.isDigit ch orelse (ord ch >= ord #"a" andalso ord ch <= ord #"f")
+
+fun validIpv6 s =
+    let
+       val fields = String.fields (fn ch => ch = #":") s
+
+       val empties = foldl (fn ("", n) => n + 1
+                             | (_, n) => n) 0 fields
+
+       fun noIpv4 maxLen =
+           length fields >= 2
+           andalso length fields <= maxLen
+           andalso empties <= 1
+           andalso List.all (fn "" => true
+                              | s => size s <= 4
+                                     andalso CharVector.all isHexDigit s) fields
+
+       fun hasIpv4 () =
+           length fields > 0
+           andalso
+           let
+               val maybeIpv4 = List.last fields
+               val theRest = List.take (fields, length fields - 1)
+           in
+               validIp maybeIpv4 andalso noIpv4 6
+           end
+    in
+       noIpv4 8 orelse hasIpv4 ()
+    end
+
 fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
 
 fun validHost s =
@@ -143,6 +173,10 @@ val _ = Env.type_one "ip"
        Env.string
        validIp
 
+val _ = Env.type_one "ipv6"
+       Env.string
+       validIpv6
+
 val _ = Env.type_one "host"
        Env.string
        validHost

diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml
index 20c3c10..89b3938 100644 (file)
--- a/src/plugins/bind.sml
+++ b/src/plugins/bind.sml
@@ -50,6 +50,8 @@ datatype dns_record =
        | MX of int * string
        | NS of string
        | DefaultA of string
+       | AAAA of string * string
+       | DefaultAAAA of string
 
 val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
                (case (Env.string e1, Domain.ip e2) of
@@ -66,7 +68,13 @@ val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
              | (EApp ((EVar "dnsNS", _), e), _) =>
                Option.map NS (Env.string e)
              | (EApp ((EVar "dnsDefaultA", _), e), _) =>
-               Option.map DefaultA (Env.string e)
+               Option.map DefaultA (Domain.ip e)
+             | (EApp ((EApp ((EVar "dnsAAAA", _), e1), _), e2), _) =>
+               (case (Env.string e1, Env.string e2) of
+                    (SOME v1, SOME v2) => SOME (AAAA (v1, v2))
+                  | _ => NONE)
+             | (EApp ((EVar "dnsDefaultAAAA", _), e), _) =>
+               Option.map DefaultAAAA (Env.string e)
              | _ => NONE
 
 fun writeRecord (evs, r) =
@@ -116,6 +124,20 @@ fun writeRecord (evs, r) =
                            write "\tIN\tNS\t";
                            write host;
                            write ".\n")
+             | AAAA (from, to) => (write from;
+                                   write ".";
+                                   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")
        end
 
 val () = Env.actionV_one "dns"