Patch title: Release 87 bulk changes
Abstract:
File: /pliant/protocol/dns/client.pli
Key:
    Removed line
    Added line
abstract
  [This is a DNS client implementation, according to RFC 1035.]

module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "common.pli"
module "name.pli"
module "/pliant/language/os/socket.pli"


doc
  [Use field=1 to get the A field (IP address).] ; eol
  [Use field=15 to get the MX field (mail server name of the domain).] ; eol
  para
    [The 'dns_query' function works in three stages:]
    list
      item [First it will build the query packet.]
      item [Second, it calls 'query_cache', and 'query_providers' is the answer was not cached yet, to get the answer packet.]
      item [Third, it parses the answer packet to get the requested field.]
    [So, this client implementation will benefit from caching just like the server does.]


function dns_query name field dns timeout -> answer
  arg Str name ; arg Int field ; arg Str dns ; arg Float timeout ; arg Str answer
  if field=1 and dns:len=0
    answer := name_ip name
    if answer<>""
      return
  if field=15 and dns:len=0
    var Data:NameDomain d :> name_database:data:domain name
    if exists:d
      answer := ""
      each m d:mail
        answer += (shunt answer:len>0 " " "")+m
      return
  var Str name2 := name ; var Int count := 3
  part query_name
    answer := ""
    var Int limit := 512
    var Address buf := memory_allocate limit null
    var Pointer:DnsHeader h :> buf map DnsHeader ; var Int offset := DnsHeader size
    h id := 0
    h flags := 100h
    h qdcount := 1
    h ancount := 0
    h nscount := 0
    h arcount := 0
    write_name buf offset limit name2
    var Pointer:DnsTail t :> (buf translate Byte offset) map DnsTail ; offset += DnsTail size
    t qtype := field
    t qclass := 1
    (var Str raw_query) set buf offset true
    if dns=""
      var Str raw_answer := query_cache raw_query
      if raw_answer=""
        raw_answer := query_providers raw_query
    else
      raw_answer := query_provider raw_query dns timeout
    buf := raw_answer characters ; limit := raw_answer len
    if DnsHeader:size>limit
      return
    h :> buf map DnsHeader ; offset := DnsHeader size
    var Str alias := name2
    var Index mail_servers
    for (var Int i) 0 h:qdcount+h:ancount+h:nscount-1
      var Str id := read_name buf offset limit
      if offset+DnsTail:size>limit
        return
      var Pointer:DnsTail t :> (buf translate Byte offset) map DnsTail ; offset += DnsTail size
      if i>=h:qdcount
        if offset+DnsAnswer:size>limit
          return
        var Pointer:DnsAnswer a :> (buf translate Byte offset) map DnsAnswer ; offset += DnsAnswer size 
        if offset+a:rdlength>limit
          return
        if t:qtype=1 and a:rdlength=4
          var Str ip := ""
          for (var Int j) 0 3
            ip += (shunt j=0 "" ".")+string:(cast ((buf translate Byte offset+j) map uInt8) Int)
          if id=alias and field=1
            answer := ip
        eif t:qtype=5
          if id=alias
            var Int offset2 := offset ; alias := read_name buf offset2 limit
        eif t:qtype=15 and a:rdlength>=3
          if id=alias and field=15
            var Int priority := (buf translate Byte offset) map uInt16_hi
            var Int offset2 := offset+uInt16:size ; var Str mailserver := read_name buf offset2 limit
            mail_servers insert (right string:priority 5 " ") addressof:(new Str mailserver)
        eif t:qtype=16 and a:rdlength>=1
          if id=alias
            answer set (memory_allocate a:rdlength-1 addressof:answer) a:rdlength-1 true
            memory_copy (buf translate Byte offset+1) answer:characters a:rdlength-1
        offset += a:rdlength
    if field=15
      var Pointer:Arrow cursor :> mail_servers first
      while cursor<>null
        answer += (shunt answer:len>0 " " "")+(cursor map Str)
        cursor :> mail_servers next cursor
    if answer="" and alias<>name2 and count>0
      name2 := alias ; count -= 1
      restart query_name

function dns_query name field -> answer
  arg Str name ; arg Int field ; arg Str answer
  answer := dns_query name field "" 0

constant os_resolution  (dns_query_os "www.debian.org")<>""
constant direct_resolution (dns_query "www.debian.org" 1)<>""
if os_resolution and not direct_resolution
  console "Using "+os_api+" API for name -> IP address resolution." eol
  compile_log "Using "+os_api+" API for name -> IP address resolution."

function dns_query name -> answer
  arg Str name; arg Str answer
  answer := dns_query name 1
  if os_resolution and not direct_resolution
    if answer=""
      answer := dns_query_os name
  
dns_query_function :> the_function dns_query Str -> Str

export dns_query