Patch title: Release 94 bulk changes
Abstract:
File: /pliant/protocol/dns/server.pli
Key:
    Removed line
    Added line
   
abstract
  [This is a partial DNS server implementation, according to


abstract
  [This is a partial DNS server implementation, according to


module "/pliant/install/minimal.pli"
module "/pliant/language/compiler.pli"
submodule "/pliant/protocol/common/tcp_server.pli"
module "/pliant/protocol/common/misc.pli"
module "/pliant/language/stream.pli"
module "/pliant/fullpliant/this_computer.pli"
module "common.pli"
module "name.pli"
module "/pliant/protocol/http/proxy.pli"
module "/pliant/protocol/http/site.pli"


function build_answer d d2 field flags adr size s
  arg Data:NameDomain d d2 ; arg Int field flags ; arg Addre
  var Address start := s stream_write_cur
  s write_header adr size flags
  var Int count1 := 0
  var Int count2 := 0
  var Int count3 := 0
  var Dictionary extra
  if field=6 or field=255 # query SOA field
    if exists:d and d:authoritative
      build_soa_field d s
      count1 += 1
  if field=2 or field=255 # query NS field
    each ns d:dns
      s write_cached_name DnsHeader:size
      s write_answer 2 ns:len+2 0
      extra record ns s start
      s write_name ns
      count1 += 1
  if field=15 or field=255 # query MX field
    var uInt16_hi priority := 1
    each m d:mail
      s write_cached_name DnsHeader:size
      s write_answer 15 uInt16_hi:size+m:len+2 0
      s raw_write addressof:priority uInt16_hi:size ; priori
      extra record m s start
      s write_name m
      count1 += 1
  if field=1 or field=255 # query A field
    var Str answer := name_ip keyof:d
    if http_proxy_user:len>0 and (s query "remote_ip_address
      var Data:NameHost host :> name_database:data:host keyo
      if exists:host and host:public_key:len>0
        answer := "127.0.0.1"
      var Data:Site site :> site_database:data:site keyof:d
      if exists:site and site:public_key:len>0
        answer := "127.0.0.1"
    if (answer parse (var uInt ip1) "." (var uInt ip2) "." (
      s write_cached_name DnsHeader:size
      s write_ip_answer ip1 ip2 ip3 ip4 0
      count1 += 1
  if field=28 or field=255 # query AAAA field
    var Str answer := name_ip keyof:d
    if (is_ipv6 answer (var uInt ip1) (var uInt ip2) (var uI
      s write_cached_name DnsHeader:size
      s write_ipv6_answer ip1 ip2 ip3 ip4 ip5 ip6 ip7 ip8 0
      count1 += 1
  if field=12 or field=255 # query PTR field
    var Data:NameReverse r :> name_database:data:reverse key
    each ptr r:ptr
      s write_cached_name DnsHeader:size
      s write_answer 12 ptr:len+2 0
      s write_name ptr
      count1 += 1
  if count1=0 and exists:d2 and d2:authoritative # autority 
    build_soa_field d2 s
    count2 += 1
  eif field<>2 and (field<>255 or not exists:d) # autority N
    each ns d2:dns
      if count2=0
        var Int offset2 := (cast s:stream_write_cur Int) .-.
        s write_name keyof:d2
      else
        s write_cached_name offset2
      s write_answer 2 ns:len+2 0
      extra record ns s start
      s write_name ns
      count2 += 1
  each e extra type DnsExtra getkey n
    if (e:ip parse (var uInt ip1) "." (var uInt ip2) "." (va
      s write_cached_name e:offset
      s write_ip_answer ip1 ip2 ip3 ip4 0
      count3 += 1
    eif (is_ipv6 e:ip (var uInt ip1) (var uInt ip2) (var uIn
      s write_cached_name e:offset
      s write_ipv6_answer ip1 ip2 ip3 ip4 ip5 ip6 ip7 ip8 0
      count3 += 1
  (start translate uInt16_hi 3) map uInt16_hi := count1
  (start translate uInt16_hi 4) map uInt16_hi := count2
  (start translate uInt16_hi 5) map uInt16_hi := count3
  var Pointer:DnsHeader h :> start map DnsHeader
  if count1=0 and (h:flags .and. 15)=0
module "/pliant/language/compiler.pli"
submodule "/pliant/protocol/common/tcp_server.pli"
module "/pliant/protocol/common/misc.pli"
module "/pliant/language/stream.pli"
module "/pliant/fullpliant/this_computer.pli"
module "common.pli"
module "name.pli"
module "/pliant/protocol/http/proxy.pli"
module "/pliant/protocol/http/site.pli"


function build_answer d d2 field flags adr size s
  arg Data:NameDomain d d2 ; arg Int field flags ; arg Addre
  var Address start := s stream_write_cur
  s write_header adr size flags
  var Int count1 := 0
  var Int count2 := 0
  var Int count3 := 0
  var Dictionary extra
  if field=6 or field=255 # query SOA field
    if exists:d and d:authoritative
      build_soa_field d s
      count1 += 1
  if field=2 or field=255 # query NS field
    each ns d:dns
      s write_cached_name DnsHeader:size
      s write_answer 2 ns:len+2 0
      extra record ns s start
      s write_name ns
      count1 += 1
  if field=15 or field=255 # query MX field
    var uInt16_hi priority := 1
    each m d:mail
      s write_cached_name DnsHeader:size
      s write_answer 15 uInt16_hi:size+m:len+2 0
      s raw_write addressof:priority uInt16_hi:size ; priori
      extra record m s start
      s write_name m
      count1 += 1
  if field=1 or field=255 # query A field
    var Str answer := name_ip keyof:d
    if http_proxy_user:len>0 and (s query "remote_ip_address
      var Data:NameHost host :> name_database:data:host keyo
      if exists:host and host:public_key:len>0
        answer := "127.0.0.1"
      var Data:Site site :> site_database:data:site keyof:d
      if exists:site and site:public_key:len>0
        answer := "127.0.0.1"
    if (answer parse (var uInt ip1) "." (var uInt ip2) "." (
      s write_cached_name DnsHeader:size
      s write_ip_answer ip1 ip2 ip3 ip4 0
      count1 += 1
  if field=28 or field=255 # query AAAA field
    var Str answer := name_ip keyof:d
    if (is_ipv6 answer (var uInt ip1) (var uInt ip2) (var uI
      s write_cached_name DnsHeader:size
      s write_ipv6_answer ip1 ip2 ip3 ip4 ip5 ip6 ip7 ip8 0
      count1 += 1
  if field=12 or field=255 # query PTR field
    var Data:NameReverse r :> name_database:data:reverse key
    each ptr r:ptr
      s write_cached_name DnsHeader:size
      s write_answer 12 ptr:len+2 0
      s write_name ptr
      count1 += 1
  if count1=0 and exists:d2 and d2:authoritative # autority 
    build_soa_field d2 s
    count2 += 1
  eif field<>2 and (field<>255 or not exists:d) # autority N
    each ns d2:dns
      if count2=0
        var Int offset2 := (cast s:stream_write_cur Int) .-.
        s write_name keyof:d2
      else
        s write_cached_name offset2
      s write_answer 2 ns:len+2 0
      extra record ns s start
      s write_name ns
      count2 += 1
  each e extra type DnsExtra getkey n
    if (e:ip parse (var uInt ip1) "." (var uInt ip2) "." (va
      s write_cached_name e:offset
      s write_ip_answer ip1 ip2 ip3 ip4 0
      count3 += 1
    eif (is_ipv6 e:ip (var uInt ip1) (var uInt ip2) (var uIn
      s write_cached_name e:offset
      s write_ipv6_answer ip1 ip2 ip3 ip4 ip5 ip6 ip7 ip8 0
      count3 += 1
  (start translate uInt16_hi 3) map uInt16_hi := count1
  (start translate uInt16_hi 4) map uInt16_hi := count2
  (start translate uInt16_hi 5) map uInt16_hi := count3
  var Pointer:DnsHeader h :> start map DnsHeader
  if count1=0 and (h:flags .and. 15)=0
    if field<>1 and field<>2 and field<>6 and field<>12 and 
    if field<>1 and field<>2 and field<>5 and field<>6 and field<>12 and field<>15 and field<>28 and field<>255
      h flags += 4 # not implemented
    eif not exists:d and (name_ip keyof:d)="" and not exists
      h flags += 3 # name does not exist (NXDOMAIN)
    


define_tcp_server DnsServer dns_server
export dns_server dns_refresh dns_hits
      h flags += 4 # not implemented
    eif not exists:d and (name_ip keyof:d)="" and not exists
      h flags += 3 # name does not exist (NXDOMAIN)
    


define_tcp_server DnsServer dns_server
export dns_server dns_refresh dns_hits