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};
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;
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);
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 =
Env.string
validIp
+val _ = Env.type_one "ipv6"
+ Env.string
+ validIpv6
+
val _ = Env.type_one "host"
Env.string
validHost
| 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
| (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) =
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"