/pliant/protocol/dns/client.pli
 
 1  abstract 
 2    [This is a DNS client implementation, according to RFC 1035.] 
 3   
 4  module "/pliant/language/compiler.pli" 
 5  module "/pliant/language/context.pli" 
 6  module "common.pli" 
 7  module "name.pli" 
 8  module "/pliant/language/os/socket.pli" 
 9   
 10   
 11  doc 
 12    [Use field=1 to get the A field (IP address).] ; eol 
 13    [Use field=15 to get the MX field (mail server name of the domain).] ; eol 
 14    para 
 15      [The 'dns_query' function works in three stages:] 
 16      list 
 17        item [First it will build the query packet.] 
 18        item [Second, it calls 'query_cache', and 'query_providers' is the answer was not cached yet, to get the answer packet.] 
 19        item [Third, it parses the answer packet to get the requested field.] 
 20      [So, this client implementation will benefit from caching just like the server does.] 
 21   
 22   
 23  function dns_query name field dns timeout -> answer 
 24    arg Str name ; arg Int field ; arg Str dns ; arg Float timeout ; arg Str answer 
 25    if field=and dns:len=0 
 26      answer := name_ip name 
 27      if answer<>"" 
 28        return 
 29    if field=15 and dns:len=0 
 30      var Data:NameDomain :> name_database:data:domain name 
 31      if exists:d 
 32        answer := "" 
 33        each d:mail 
 34          answer += (shunt answer:len>" " "")+m 
 35        return 
 36    var CBool use_cache := dns="" 
 37    var Str name2 := name ; var Int count := 3 
 38    part query_name 
 39      answer := "" 
 40      var Int limit := 512 
 41      var Address buf := memory_allocate limit null 
 42      var Pointer:DnsHeader :> buf map DnsHeader ; var Int offset := DnsHeader size 
 43      id := 0 
 44      flags := 100h 
 45      qdcount := 1 
 46      ancount := 0 
 47      nscount := 0 
 48      arcount := 0 
 49      write_name buf offset limit name2 
 50      var Pointer:DnsTail :> (buf translate Byte offset) map DnsTail ; offset += DnsTail size 
 51      qtype := field 
 52      qclass := 1 
 53      (var Str raw_query) set buf offset true 
 54      var Str raw_answer 
 55      if dns<>"" 
 56        raw_answer := query_provider raw_query dns timeout 
 57      eif use_cache 
 58        raw_answer := query_cache raw_query 
 59        if raw_answer="" 
 60          raw_answer := query_providers raw_query 
 61      else 
 62        raw_answer := query_providers raw_query 
 63      buf := raw_answer characters ; limit := raw_answer len 
 64      if DnsHeader:size>limit 
 65        return 
 66      :> buf map DnsHeader ; offset := DnsHeader size 
 67      var Str alias := name2 
 68      var Index mail_servers 
 69      for (var Int i) h:qdcount+h:ancount+h:nscount-1 
 70        var Str id := read_name buf offset limit 
 71        if offset+DnsTail:size>limit 
 72          return 
 73        var Pointer:DnsTail :> (buf translate Byte offset) map DnsTail ; offset += DnsTail size 
 74        if i>=h:qdcount 
 75          if offset+DnsAnswer:size>limit 
 76            return 
 77          var Pointer:DnsAnswer :> (buf translate Byte offset) map DnsAnswer ; offset += DnsAnswer size  
 78          if offset+a:rdlength>limit 
 79            return 
 80          if t:qtype=and a:rdlength=4 
 81            var Str ip := "" 
 82            for (var Int j) 0 3 
 83              ip += (shunt j="" ".")+string:(cast ((buf translate Byte offset+j) map uInt8) Int) 
 84            if id=alias and field=1 
 85              answer := ip 
 86          eif t:qtype=5 
 87            if id=alias 
 88              var Int offset2 := offset ; alias := read_name buf offset2 limit 
 89          eif t:qtype=15 and a:rdlength>=3 
 90            if id=alias and field=15 
 91              var Int priority := (buf translate Byte offset) map uInt16_hi 
 92              var Int offset2 := offset+uInt16:size ; var Str mailserver := read_name buf offset2 limit 
 93              mail_servers insert (right string:priority " "addressof:(new Str mailserver) 
 94          eif t:qtype=16 and a:rdlength>=1 
 95            if id=alias 
 96              answer set (memory_allocate a:rdlength-addressof:answer) a:rdlength-true 
 97              memory_copy (buf translate Byte offset+1) answer:characters a:rdlength-1 
 98          offset += a:rdlength 
 99      if field=15 
 100        var Pointer:Arrow cursor :> mail_servers first 
 101        while cursor<>null 
 102          answer += (shunt answer:len>" " "")+(cursor map Str) 
 103          cursor :> mail_servers next cursor 
 104      if answer="" and alias<>name2 and count>0 
 105        name2 := alias ; count -= 1 
 106        restart query_name 
 107      if answer="" and use_cache 
 108        use_cache := false 
 109        restart query_name 
 110   
 111  function dns_query name field -> answer 
 112    arg Str name ; arg Int field ; arg Str answer 
 113    answer := dns_query name field "" 0 
 114   
 115  constant os_resolution  (dns_query_os "www.debian.org")<>"" 
 116  constant direct_resolution (dns_query "www.debian.org" 1)<>"" 
 117  if os_resolution and not direct_resolution 
 118    compile_log "Using "+os_api+" API for name -> IP address resolution." 
 119   
 120  function dns_query name -> answer 
 121    arg Str name; arg Str answer 
 122    answer := dns_query name 1 
 123    if os_resolution and not direct_resolution 
 124      if answer="" 
 125        answer := dns_query_os name 
 126     
 127  dns_query_function :> the_function dns_query Str -> Str 
 128   
 129  export dns_query