From b2ef848df497436d3807515ae84613c77fd57f3e Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Wed, 22 Oct 2008 09:54:59 -0500
Subject: [PATCH] Add 'dns.resolver'

---
 extra/dns/resolver/resolver.factor | 66 ++++++++++++++++++++++++++++++
 1 file changed, 66 insertions(+)
 create mode 100644 extra/dns/resolver/resolver.factor

diff --git a/extra/dns/resolver/resolver.factor b/extra/dns/resolver/resolver.factor
new file mode 100644
index 0000000000..dff1afbb18
--- /dev/null
+++ b/extra/dns/resolver/resolver.factor
@@ -0,0 +1,66 @@
+
+USING: kernel accessors namespaces continuations
+       io io.sockets io.binary io.timeouts io.encodings.binary
+       destructors
+       locals strings sequences random prettyprint calendar dns ;
+
+IN: dns.resolver
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: send-receive-udp ( BA SERVER -- ba )
+   T{ inet4 f f 0 } <datagram>
+   T{ duration { second 3 } } over set-timeout
+     [| SOCKET | BA SERVER SOCKET send SOCKET receive drop ]
+   with-disposal ;
+
+:: send-receive-tcp ( BA SERVER -- ba )
+   [let | BA [ BA length 2 >be BA append ] |
+     SERVER binary
+       [
+         T{ duration { second 3 } } input-stream get set-timeout
+         BA write flush 2 read be> read
+       ]
+     with-client                                        ] ;
+
+:: send-receive-server ( BA SERVER -- msg )
+   [let | RESULT [ BA SERVER send-receive-udp parse-message ] |
+     RESULT tc>> 1 =
+       [ BA SERVER send-receive-tcp parse-message ]
+       [ RESULT                                   ]
+     if                                                 ] ;
+
+: >dns-inet4 ( obj -- inet4 ) dup string? [ 53 <inet4> ] [ ] if ;
+
+:: send-receive-servers ( BA SERVERS -- msg )
+   SERVERS empty? [ "send-receive-servers: servers list empty" throw ] when
+   [let | SERVER [ SERVERS random >dns-inet4 ] |
+     ! if this throws an error ...
+     [ BA SERVER send-receive-server ]
+     ! we try with the other servers...
+     [ drop BA SERVER SERVERS remove send-receive-servers ]
+     recover                                            ] ;
+
+:: ask-servers ( MSG SERVERS -- msg )
+   MSG message->ba SERVERS send-receive-servers ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: fully-qualified ( name -- name ) dup "." tail? [ ] [ "." append ] if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: dns-servers ( -- seq ) \ dns-servers get ;
+
+! : dns-server ( -- server ) dns-servers random ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: dns-ip ( name -- ips )
+  fully-qualified
+  [let | MSG [ A IN query boa query->message dns-servers ask-servers ] |
+    MSG rcode>> NO-ERROR =
+      [ MSG answer-section>> [ type>> A = ] filter [ rdata>> ] map ]
+      [ "dns-ip: rcode = " MSG rcode>> unparse append throw        ]
+    if ] ;
+