Patch title: Release 94 bulk changes
Abstract:
File: /pliant/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) 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 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 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) 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
table columns 3
  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]
              [IP:]
            cell
              input "" n:ip
            cell
              [Connection mode]
              [Options:]
            cell
              select "" n:location
                option "Fixed" "F"
                option "Mobile" "M"
              input "" n:options length 60
            cell
              [Comment]
              [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
                var Int 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
            [Building:]
          cell
            input " " h:building length 30
          cell
            [Physical server name:]
          cell
            input "" h:physical length 30 noeol
            input "" h:physical length 30
          cell
            [IP address:]
          cell
            input " " h:ip length 16
          cell
            [HTTP port:]
            [TCP ports:]
          cell
            input "" h:http_port length 5
            input "Pliant multiservice: " h:port length 5 noeol
            input "HTTP: " h:http_port length 5 noeol
            input " Remote execution: " h:remote_port length 5
          cell
            [Remote execution port:]
            [Options:]
          cell
            input "" h:remote_port length 5
          cell
            [Options]
          cell
            input "" h:options length 60
          if allowed:"administrator"
            cell
              [Comment]
              [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"
header "Buildings"

[List of currently defined buildings:]
table columns 2
  cell header
    [ID]
  cell void
  each b name_database:data:building
    cell
      fixed (text keyof:b)
    cell
      if allowed:"administrator"
        page button "edit"
          title "'"+keyof:b+"' building"
          table columns 2
            cell
              [Proxys:]
            cell
              table columns 2 border 0
                each proxy b:proxy
                  cell
                    text keyof:proxy
                  cell
                    text proxy
            cell
              [Options:]
            cell
              input "" b:options length 60
            cell
              [Comment:]
            cell
              text_input "" b:comment columns 60 rows 10
          input "Proxy line ID: " (var Str pid) length 2 noeol
          input " and name: " (var Str pname) length 30 noeol
          button "Record proxy" noeol
            b:proxy create pid
            b:proxy pid := pname
            reload_page
          button "Remove proxy"
            b:proxy delete pid
            reload_page
          button "Update"
            goto_backward   

if allowed:"administrator"
  input "Name: " (var Str bid) length 30 noeol
  button "Create the new building" noeol
    name_database:data:building create bid
    reload_page
  button "Delete the building"
    name_database:data:building delete bid
    reload_page


header "Web sites"

  [Theses are the ]
  link "web site definitions" "/pliant/protocol/http/site.html"
  link "web sites 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