Update of /cvsroot/hcoop/domtool2/src/plugins
In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv11665/src/plugins
Modified Files:
bind.sml
Log Message:
bind_patterns
Index: bind.sml
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/plugins/bind.sml,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** bind.sml 1 Jan 2008 23:07:50 -0000 1.18
--- bind.sml 18 Feb 2008 16:38:00 -0000 1.19
***************
*** 45,67 ****
val dl = ErrorMsg.dummyLoc
datatype dns_record =
! A of string * string
! | CNAME of string * 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
| AFSDB of string
| SRV of string * int * int * int * string
val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
! (case (Env.string 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
(SOME v1, SOME v2) => SOME (CNAME (v1, v2))
| _ => NONE)
--- 45,81 ----
val dl = ErrorMsg.dummyLoc
+ datatype host =
+ Literal of string
+ | Wildcard
+ | Default
+
datatype dns_record =
! A of host * string
! | CNAME of host * string
| MX of int * string
| NS 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 (host e1, Domain.ip e2) of
(SOME v1, SOME v2) => SOME (A (v1, v2))
| _ => NONE)
| (EApp ((EApp ((EVar "dnsCNAME", _), e1), _), e2), _) =>
! (case (host e1, Env.string e2) of
(SOME v1, SOME v2) => SOME (CNAME (v1, v2))
| _ => NONE)
***************
*** 72,89 ****
| (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
(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
(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)
--- 86,97 ----
| (EApp ((EVar "dnsNS", _), e), _) =>
Option.map NS (Env.string e)
| (EApp ((EApp ((EVar "dnsAAAA", _), e1), _), e2), _) =>
! (case (host e1, Env.string e2) of
(SOME v1, SOME v2) => SOME (AAAA (v1, v2))
| _ => NONE)
| (EApp ((EApp ((EVar "dnsTXT", _), e1), _), e2), _) =>
! (case (host e1, Env.string e2) of
(SOME v1, SOME v2) => SOME (TXT (v1, v2))
| _ => NONE)
| (EApp ((EVar "dnsAFSDB", _), e), _) =>
Option.map AFSDB (Env.string e)
***************
*** 105,110 ****
in
case r of
! A (from, to) => (write from;
! write ".";
writeDom ();
write ".\t";
--- 113,117 ----
in
case r of
! A (from, to) => (write (hostS from);
writeDom ();
write ".\t";
***************
*** 113,124 ****
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 ".";
writeDom ();
write ".\t";
--- 120,124 ----
write to;
write "\n")
! | CNAME (from, to) => (write (hostS from);
writeDom ();
write ".\t";
***************
*** 141,146 ****
write host;
write ".\n")
! | AAAA (from, to) => (write from;
! write ".";
writeDom ();
write ".\t";
--- 141,145 ----
write host;
write ".\n")
! | AAAA (from, to) => (write (hostS from);
writeDom ();
write ".\t";
***************
*** 149,160 ****
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 ".";
writeDom ();
write ".\t";
--- 148,152 ----
write to;
write "\n")
! | TXT (from, to) => (write (hostS from);
writeDom ();
write ".\t";
***************
*** 163,172 ****
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";
--- 155,158 ----
-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/
_______________________________________________
hcoop-cvs mailing list
hcoop-cvs@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/hcoop-cvs
