73 lines
2.4 KiB
Factor
73 lines
2.4 KiB
Factor
|
|
||
|
|
USING: kernel accessors namespaces continuations
|
||
|
|
io io.sockets io.binary io.timeouts io.encodings.binary
|
||
|
|
destructors
|
||
|
|
locals strings sequences random prettyprint calendar dns dns.misc ;
|
||
|
|
|
||
|
|
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
|
||
|
|
[ ]
|
||
|
|
[ resolv-conf-servers \ dns-servers set dns-servers ]
|
||
|
|
if* ;
|
||
|
|
|
||
|
|
! : dns-server ( -- server ) dns-servers random ;
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|
||
|
|
: dns-ip4 ( 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 ] ;
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|