unmaintained/dns/resolver/resolver.factor

   1
   2 USING: kernel accessors namespaces continuations
   3        io io.sockets io.binary io.timeouts io.encodings.binary
   4        destructors
   5        locals strings sequences random prettyprint calendar dns dns.misc ;
   6
   7 IN: dns.resolver
   8
   9 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  10
  11 :: send-receive-udp ( BA SERVER -- ba )
  12    T{ inet4 f f 0 } <datagram>
  13    T{ duration { second 3 } } over set-timeout
  14      [| SOCKET | BA SERVER SOCKET send SOCKET receive drop ]
  15    with-disposal ;
  16
  17 :: send-receive-tcp ( BA SERVER -- ba )
  18    [let | BA [ BA length 2 >be BA append ] |
  19      SERVER binary
  20        [
  21          T{ duration { second 3 } } input-stream get set-timeout
  22          BA write flush 2 read be> read
  23        ]
  24      with-client                                        ] ;
  25
  26 :: send-receive-server ( BA SERVER -- msg )
  27    [let | RESULT [ BA SERVER send-receive-udp parse-message ] |
  28      RESULT tc>> 1 =
  29        [ BA SERVER send-receive-tcp parse-message ]
  30        [ RESULT                                   ]
  31      if                                                 ] ;
  32
  33 : >dns-inet4 ( obj -- inet4 ) dup string? [ 53 <inet4> ] [ ] if ;
  34
  35 :: send-receive-servers ( BA SERVERS -- msg )
  36    SERVERS empty? [ "send-receive-servers: servers list empty" throw ] when
  37    [let | SERVER [ SERVERS random >dns-inet4 ] |
  38      ! if this throws an error ...
  39      [ BA SERVER send-receive-server ]
  40      ! we try with the other servers...
  41      [ drop BA SERVER SERVERS remove send-receive-servers ]
  42      recover                                            ] ;
  43
  44 :: ask-servers ( MSG SERVERS -- msg )
  45    MSG message->ba SERVERS send-receive-servers ;
  46
  47 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  48
  49 : fully-qualified ( name -- name ) dup "." tail? [ ] [ "." append ] if ;
  50
  51 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  52
  53 : dns-servers ( -- seq )
  54   \ dns-servers get
  55     [ ]
  56     [ resolv-conf-servers \ dns-servers set dns-servers ]
  57   if* ;
  58
  59 ! : dns-server ( -- server ) dns-servers random ;
  60
  61 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  62
  63 : dns-ip4 ( name -- ips )
  64   fully-qualified
  65   [let | MSG [ A IN query boa query->message dns-servers ask-servers ] |
  66     MSG rcode>> NO-ERROR =
  67       [ MSG answer-section>> [ type>> A = ] filter [ rdata>> ] map ]
  68       [ "dns-ip: rcode = " MSG rcode>> unparse append throw        ]
  69     if ] ;
  70
  71 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  72