Patch title: Release 90 bulk changes
Abstract:
File: /protocol/dns/name.page
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "name.pli"
module "/pliant/protocol/dns/client.pli"
module "/pliant/protocol/http/site.pli"
module "/pliant/fullpliant/this_computer.pli"
module "/pliant/util/crypto/rsa.pli"
module "/pliant/util/crypto/legal.pli"
# module "/pliant/fullpliant/computer.pli"

function ip_sort ip -> s
  arg Str ip s
  if (ip parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4))
  if (ip parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4) any)
    s := (right string:i1 3 "0")+"."+(right string:i2 3 "0")+"."+(right string:i3 3 "0")+"."+(right string:i4 3 "0")
  else
    s := ip

requires "browse_configuration"

read_only not allowed:"administrator"

title "Names administration"

note "DNS client and server global settings for this computer"
  read_only not allowed:"administrator"
  title "This computer DNS settings"
  table columns 3 border 0
    cell [DNS service:]
    cell
      var Str dns := this_computer:env:"pliant":"dns":"service"
      select "" dns
        option "" ""
        option "Yes" "true"
        option "No" "false"
    cell [Should we run the DNS server on this computer ?]
    cell [DNS providers:]
    cell
      var Str provider1 := this_computer:env:"pliant":"dns":"provider1"
      input "" provider1   
      input "" provider1 noeol
      if provider1<>""
        var DateTime start := datetime
        var Str answer := dns_query "www.debian.org" 1 provider1 5
        var DateTime stop := datetime
        small
          text (shunt answer<>"" "ok" "broken")+" in "+(string 1000*(stop:seconds-start:seconds) "fixed 0")+" ms"
      eol
      var Str provider2 := this_computer:env:"pliant":"dns":"provider2"
      input "" provider2   
      input "" provider2 noeol
      if provider2<>""
        var DateTime start := datetime
        var Str answer := dns_query "www.debian.org" 1 provider2 5
        var DateTime stop := datetime
        small
          text (shunt answer<>"" "ok" "broken")+" in "+(string 1000*(stop:seconds-start:seconds) "fixed 0")+" ms"
      eol
    cell [IP addresses of external DNS we should forward queries to when the request does not apply to a local domain (I mean when the Pliant DNS server behaves as a cache).]
    cell [DNS cache:]
    cell
      var Str cache := this_computer:env:"pliant":"dns":"cache"
      input "" cache 
    cell
      [For what IPs should the Pliant DNS server behaves as a DNS cache. Might be something like:]
      fixed [ 10.0.0.0/255.0.0.0 127.0.0.1]
    cell [Default domain:]
    cell
      var Str default := this_computer:env:"pliant":"dns":"default"
      input "" default
    cell
      [What domain (such as 'mycrop.com') should be added when a client requests a simple name (like 'foo' as opposed to 'foo.mycrop.com').] ; eol
      [Applies only for local queries, local meaning in the selected subsets of IP addresses defined in 'DNS cache' field.]
  if allowed:"administrator"
    button "Update"
      this_computer "pliant" "dns" "service" := dns
      if provider1<>""
        this_computer "pliant" "dns" "provider1" := provider1
      else
        this_computer:env:"pliant":"dns" delete "provider1"
      if provider2<>""
        this_computer "pliant" "dns" "provider2" := provider2
      else
        this_computer:env:"pliant":"dns" delete "provider2"
      this_computer "pliant" "dns" "cache" := cache
      this_computer "pliant" "dns" "default" := default
      goto_backward
eol
page note "Compute IP reverse mapping"
  title "IP reverse mapping"
  var (Index Str Str) ips
  each n name_database:data:name
    if (n:ip parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4))
      ips insert (ip_sort n:ip) keyof:n
  each h name_database:data:host
    if (h:ip parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4))
      ips insert (ip_sort h:ip) keyof:h
    var Int i := 0
    while ((h:options option "ip" i Str) parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4))
    while ((h:options option "ip" i Str) parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4) any)
      ips insert (ip_sort (h:options option "ip" i Str)) keyof:h
      i += 1
  if false
    each c computer_database:data:computer
      each d c:env:"net_device"
        if (d:"ip" parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4))
          ips insert (ip_sort d:"ip") keyof:c
  table columns 2
    cell header [IP]
    cell header [name]
    each ip ips
      cell
        if ((ips key ip) parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4))
          text string:i1+"."+string:i2+"."+string:i3+"."+string:i4
        else
          text (ips key ip)
      cell
        text ip   


header "Names"

[List of currently defined names:]
table columns 4
  cell header
    [Name]
  cell header
    [IP]
  cell header
    [Kind of location]
  cell void
  each n name_database:data:name
    cell
      fixed (text keyof:n)
    cell
      text n:ip ; eol
      if n:ip<>(name_ip n:ip)
        font color (color hsl 0 0 50)
          fixed text:(name_ip n:ip)
    cell
      text (shunt n:location="F" "fixed" n:location="M" "mobile" "")
    cell
      if allowed:"administrator"
        button "edit"
          title "'"+keyof:n+"' name"
          table columns 2
            cell
              [IP]
            cell
              input "" n:ip
            cell
              [Connection mode]
            cell
              select "" n:location
                option "Fixed" "F"
                option "Mobile" "M"
            cell
              [Comment]
            cell
              text_input "" n:comment columns 60 rows 10
          button "Update"
            goto_backward   

if allowed:"administrator"
  input "Name: " (var Str nid) length 30 noeol
  input " IP: " (var Str nip) length 16 noeol
  button "Create the new name" noeol
    name_database:data:name create nid
    name_database:data:name:nid ip := nip
    reload_page
  button "Delete the name"
    name_database:data:name delete nid
    reload_page


header "Hosts"

[List of currently defined hosts:]
table columns 3
  cell header [Host]
  cell header [IP]
  cell void
  each h name_database:data:host
    var Str id := keyof h
    cell
      fixed text:id
    cell
      if h:ip<>""
        fixed (text h:ip)
      eif h:physical<>""
        font color (color hsl 0 0 50)
          fixed text:(name_ip h:physical)
    cell
      button "edit"
        read_only not allowed:"administrator"
        title "'"+keyof:h+"' host"
        table columns 2
          cell
            [Public key:]
          cell
            if allowed:"administrator"
              input "" h:public_key length 30 noeol
              page button "Generate"
                title "Generate a public/private key pair for '"+id+"'"
                var Int bits := min max_legal_key_bits 1024
                input "Number of bits: " bits length 4 noeol
                button "Generate now"
                  var DateTime start := datetime
                  rsa_generate "host:"+id bits ""
                  console "generated a " bits " bits key in " datetime:seconds-start:seconds " seconds." eol
                  goto_backward
            var Int bits := rsa_nbbits h:public_key
            if bits=defined
              if name_secret_database:data:host:id:private_key<>""
                bold
                  text string:bits+" bits"
                if (name_secret_database:data:host:id:private_key parse word:"rsa" _ any:(var Str part1a) _ any) and (h:public_key parse word:"rsa" _ any:(var Str part1b) _ any) and part1a<>part1b
                  fixed [  ] ; highlight "key is corrupted !"
              else
                font color (color hsl 0 0 50)
                  text string:bits+" bits"
          cell
            [Physical server name:]
          cell
            input "" h:physical length 30 noeol
          cell
            [IP address:]
          cell
            input " " h:ip length 16
          cell
            [HTTP port:]
          cell
            input "" h:http_port length 5
          cell
            [Remote execution port:]
          cell
            input "" h:remote_port length 5
          cell
            [Options]
          cell
            input "" h:options length 60
          if allowed:"administrator"
            cell
              [Comment]
            cell
              text_input "" h:comment columns 60 rows 10
        if allowed:"administrator"
          button "Update"
            goto_backward   

if allowed:"administrator"
  input "Host: " (var Str hid) length 30 noeol
  button "Create the new host" noeol
    name_database:data:host create hid
    reload_page
  button "Delete the host"
    name_database:data:host delete hid
    name_secret_database:data:host delete hid
    reload_page


header "Sites"

  [Theses are the ]
  link "web site definitions" "/pliant/protocol/http/site.html"
  [ providing name resolution possibility:]
  eol
  table columns 2
    cell header [Site]
    cell header [IP]
    each s site
      if s:ip<>"" or s:computer<>""
        cell
          fixed (text keyof:s)
        cell
          if s:ip<>""
            fixed (text s:ip)
          eif s:computer<>""
            font color (color hsl 0 0 50)
              fixed text:(name_ip s:computer)


header "Domains"

[List of currently defined domains:]
table columns 4
  cell header
    [Domain]
  cell header
    [DNS servers]
  cell header
    [Mail servers]
  cell void
  each d name_database:data:domain
    cell
      fixed (text keyof:d)
    cell
      small
        each c_dns d:dns
          text c_dns ; eol
    cell
      small
        each c_mail d:mail
          text c_mail ; eol
    cell
      button "Edit"
        read_only not allowed:"administrator"
        title "Domain '"+keyof:d+"'"
        table columns 3 border 0
          cell [Administrator mailbox:]
          cell (input "" d:mailbox)
          cell void
          cell [Pliant DNS is authoritative for the domain:]
          cell
            select "" d:authoritative
              option "yes" "true"
              option "no" "false"
          cell [Set this to no if the domain is not handled by this DNS server.]
        para
          [DNS servers:]
          table columns 2
            cell header
              [Line ID]
            cell header
              [Name]
            each dns d:dns
              cell
                fixed (text keyof:dns) ; eol
              cell
                input "" dns
                if name_ip:dns<>""
                  font color (color hsl 0 0 50)
                    fixed (text name_ip:dns)
          if allowed:"administrator"
            input "Line ID: " (var Str did) length 8 noeol
            button "Create the new line" noeol
              d:dns create did
              reload_page
            button "Delete the line"
              d:dns delete did
              reload_page
        para
          [Mail servers:]
          table columns 2
            cell header
              [Line ID]
            cell header
              [Name]
            each mail d:mail
              cell
                fixed (text keyof:mail) ; eol
              cell
                input "" mail
                if name_ip:mail<>""
                  font color (color hsl 0 0 50)
                    fixed (text name_ip:mail)
          if allowed:"administrator"
            input "Line ID: " (var Str mid) length 8 noeol
            button "Create the new line" noeol
              d:mail create mid
              reload_page
            button "Delete the line"
              d:mail delete mid
              reload_page
        if allowed:"administrator"
          button "Update"
            goto_backward

if allowed:"administrator"
  input "Domain: " (var Str did) length 20 noeol
  button "Create the new domain" noeol
    name_database:data:domain create did
    reload_page
  button "Delete the domain"
    name_database:data:domain delete did
    reload_page


header "IP masks"

[List of currently defined IP masks:]
table columns 3
  cell header
    [IP]
  cell header
    [Mask]
  cell void
  each m name_database:data:mask
    cell
      fixed (text keyof:m) ; eol
    cell
      text m
    cell
      if allowed:"administrator"
        button "edit"
          title "'"+keyof:m+"' IP pool"
          table columns 2
            cell
              [Mask:]
            cell
              input "" m
          button "Update"
            goto_backward

if allowed:"administrator"
  input "IP: " (var Str mid) length 12 noeol
  button "Create the new IP mask" noeol
    name_database:data:mask create mid
    reload_page
  button "Delete the IP mask"
    name_database:data:mask delete mid
    reload_page


header "Reverse names"

[List of currently defined reverse names:]
table columns 3
  cell header
    [IP]
  cell header
    [Names]
  cell void
  each r name_database:data:reverse
    cell
      fixed (text keyof:r) ; eol
    cell
      small
        each c_ptr r:ptr
          text c_ptr ; eol
    cell
      if allowed:"administrator"
        button "Edit"
          title "Reverse DNS for '"+keyof:r+"'"
          [Names:]
          table columns 2
            cell header
              [Line ID]
            cell header
              [Name]
            each ptr r:ptr
              cell
                fixed (text keyof:ptr) ; eol
              cell
                input "" ptr
                if name_ip:ptr<>""
                  font color (color hsl 0 0 50)
                    fixed (text name_ip:ptr)
          input "Line ID: " (var Str pid) length 30 noeol
          button "Create the new line" noeol
            r:ptr create pid
            reload_page
          button "Delete the line"
            r:ptr delete pid
            reload_page
          button "Auto fill" noeol
            var Str all := keyof r ; var Str ip
            while all<>""
              if not (all parse any:(var Str first) "." any:(var Str remain))
                first := all ; remain := ""
              if (first parse (var Int i))
                ip := string:i+(shunt ip<>"" "." "")+ip
              all := remain
            data_reset r:ptr
            var Int u := 1
            each n name_database:data:name
              if n:ip=ip
                r:ptr create string:u
                r:ptr string:u := keyof n
                u += 1
            reload_page
          button "Update"
            goto_backward

if allowed:"administrator"
  input "Reverse entry: " (var Str rid) length 30 noeol
  button "Create the new reverse entry" noeol
    name_database:data:reverse create rid
    reload_page
  button "Delete the reverse entry"
    name_database:data:reverse delete rid
    reload_page


if allowed:"administrator"
  header "Actions"
  
  button "Now record changes"
    goto_backward

  var CBool migrate := false
  each n name_database:data:name
    if (exists name_database:data:host:(keyof n))
      migrate := true
  if migrate
    para
      page button "Drop no use hosts IPs" noeol
        each n name_database:data:name
          if (exists name_database:data:host:(keyof n))
            name_database:data:host:(keyof n) ip := n ip
            name_database:data:name delete keyof:n
        reload_page

  var CBool migrate := false
  each n name_database:data:name
    if (name_ip site_database:data:site:(keyof n):computer)=(name_ip n:ip)
      migrate := true
    eif site_database:data:site:(keyof n):ip=(name_ip n:ip)
      migrate := true
  if migrate
    para
      page button "Drop no use sites IPs"
        each n name_database:data:name
          if (name_ip site_database:data:site:(keyof n):computer)=(name_ip n:ip)
            name_database:data:name delete keyof:n
          eif site_database:data:site:(keyof n):ip=(name_ip n:ip)
            name_database:data:name delete keyof:n
        reload_page