Patch title: Release 89 bulk changes
Abstract:
File: /fullpliant/logical.page
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "this_computer.pli"
module "/pliant/protocol/dns/name.pli"
module "/pliant/protocol/http/site.pli"
module "/pliant/fullpliant/user.pli"
module "/pliant/admin/file.pli"
module "/pliant/linux/kernel/device.pli"
module "/pliant/util/crypto/rsa.pli"
module "/pliant/util/remote/common.pli"
module "/pliant/appli/database/light.pli"
module "logical.pli"

requires "administrator"


function data_write file path value
  arg Str file path value
  if (data_read file path (var Str v))=failure or v<>value
    (var Stream s) open file append+mkdir+safe
    s writeline "<pdata path=[dq]"+path+"[dq]>"+value+"</pdata>"


title "Logical computers"

table columns 5
  cell header [Name]
  cell header [Memory]
  cell header [Status]
  cell header [Action]
  cell void
  var Intn total_used := 0 ; var Intn total_assigned := 0
  each logical this_computer:env:"logical"
    var Str name := keyof logical
    var CBool running := lc_is_running keyof:logical
    cell
      text name
    cell
      var Intn used := lc_memory name
      if used<>undefined
        text (string used\2^20)
        total_used += used
      text " / "
      if (this_computer:env:"logical":name:"memory" parse (var Intn assigned))
        assigned *= 2^20
      else
        assigned := undefined
      if (this_computer:env:"logical":name:"memory_overflow" parse (var Intn overflow))
        overflow *= 2^20
      else
        overflow := undefined
      if assigned<>undefined
        text (string assigned\2^20)
        total_assigned += assigned
      if overflow<>undefined
        text " < "+(string overflow\2^20)
    cell
      text (shunt running "running" "stopped")
    cell
      if not running and logical:"automatic"<>"true"
        page button "Start"
          lc_start keyof:logical
          sleep 1
          reload_page
      if running
        button "Stop"
          lc_stop keyof:logical
          sleep 1
          reload_page
    cell
      page button "edit"
        title "'"+name+"' logical computer"
        each va this_computer:env:"logical":name
          if va=""
            this_computer:env:"logical":name delete keyof:va
        text "Raw settings for '"+name+"':"
        table columns 2
          cell header [Variable]
          cell header [Value]
          each va this_computer:env:"logical":name
            cell (text keyof:va)
            cell text:va
        name_database:data:host create name
          
        header "Configuration"
          table columns 2
            var Str auto := this_computer:env:"logical":name:"automatic"
            cell [Start automatically]
            cell
              select "" auto
                option "" ""
                option "yes" "true"
                option "no" "false"
            var Str root := lc_root name
            cell [Root path]
            cell (input "" (var Str root))
            var Str cooped := this_computer:env:"logical":name:"cooped"
            cell (text "Cooped up in "+lc_root:name)
            cell
              select "" cooped
                option "" ""
                option "yes" "true"
                option "no" "false"
            var Str user := string lc_user:name
            cell [User ID]
            cell (input "" (var Str user) length 6)
            var Str group := string lc_group:name
            cell [Group ID]
            cell (input "" (var Str group) length 6)
            var Str mem := this_computer:env:"logical":name:"memory"
            cell [Assigned memory]
            cell
              input "" mem length 5 noeol ; [ MB]
            var Str mem2 := this_computer:env:"logical":name:"memory_overflow"
            cell [Maximum memory]
            cell
              input "" mem2 length 5 noeol ; [ MB]
            cell [HTTP TCP port]
            cell (input "" name_database:data:host:name:http_port length 5)
            var Str remote := this_computer:env:"logical":name:"remote"
            cell [Run remote execution service]
            cell
              select "" remote
                option "" ""
                option "yes" "true"
                option "no" "false"
            cell [Remote execution TCP port]
            cell (input "" name_database:data:host:name:remote_port length 5)
            var Str cluster := this_computer:env:"logical":name:"cluster"
            cell [Run clustering service]
            cell
              select "" cluster
                option "" ""
                option "yes" "true"
                option "no" "false"
          button "update"
            this_computer "logical" name "automatic" := auto
            this_computer "logical" name "root" := root
            this_computer "logical" name "cooped" := cooped
            this_computer "logical" name "user" := user
            this_computer "logical" name "group" := group
            this_computer "logical" name "memory" := mem
            this_computer "logical" name "memory_overflow" := mem2
            this_computer "logical" name "remote" := remote
            this_computer "logical" name "cluster" := cluster
            reload_page    

        header "Host settings"
          para
            if name_ip:name=name_ip:computer_fullname
              text "The IP address of '"+name+"' is "+name_ip:name+"; this is correct." ; eol
            eif name_ip:name<>""
              text "The IP address of '"+name+"' is "+name_ip:name+" instead of "+name_ip:computer_fullname ; eol
            else
              text "The IP address of '"+name+"' is not defined yet." ; eol
            if name_secret_database:data:host:name:private_key<>""
              text "'"+name+"' currently has a "+string:(rsa_nbbits name_secret_database:data:host:name:private_key)+" bits secret key." ; eol
            else
              text "'"+name+"' currently has no secret key." ; eol

          if (exists name_database:data:name:name)
            [The host name is defined in the IP database of the DNS: it should not. ]
            button "remove it"
              name_database:data:name delete name
              reload_page
          if (exists site_database:data:site:name)
            [The host name is defined in the web sites database: it should not. ]
            button "remove it"
              site_database:data:site delete name
              reload_page
          var Data:NameHost h :> name_database:data:host:name
          if not exists:h
            [The logical computer is not declared yet as a host.] ; eol
          else
            if h:physical<>computer_fullname
              [The physical computer name is wrong in the hosts database.]
            if h:public_key=""
              [The logical computer does not have a public key.]
          para
            [The logical server is powering the following ] ; link "web sites" "/pliant/protocol/http/site.html" ; [:]
            table columns 2
              cell header [Site]
              cell void
              each a_site site
                if a_site:computer=name
                  cell
                    text keyof:a_site
                  cell
                    if name_ip:name<>name_ip:computer_fullname
                      text "The IP address of '"+name+"' is "+name_ip:name+" !"
          var Int bits := 128
          page button "Generate" noeol
            rsa_generate "host:"+name bits ""
            reload_page
          input "a " bits length 4 noeol ; [ bits secret key.]

        header "Files"
          if (file_query lc_root:name standard)=undefined
            [The files tree does not exist yet.] ; eol
          table columns 2 border 0
            for (var Int lap) 0 3
              cell
                page button (shunt lap=0 "Install files tree" lap=1 "Reinstall OS files" lap=2 "Reinstall Pliant tree" "Reinstall configuration file") noeol
                  var Str path := lc_root name
                  part create_directories
                    file_tree_create path+"pliant_security/"
                    file_tree_create path+"pliant_data/"
                    file_tree_create path+"tmp/"
                  if lap=0 or lap=2
                    part copy_pliant
                      file_tree_copy "/pliant/" path+"pliant/pliant/"
                      file_copy "/index.page" path+"pliant/index.page"
                      var Array:FileInfo files := file_list "/binary/" standard+relative
                      for (var Int i) 0 files:size-1
                        if files:i:extension<>".dump"
                          file_copy "/binary/"+files:i:name path+"pliant/binary/"+files:i:name
                  if lap=0 or lap=1
                    part copy_bin
                      file_tree_create path+"bin/"
                      file_link "file:/pliant/binary/pliant-debug1.exe" path+"bin/pliant"
                      file_link "file:/pliant/binary/pliant-debug1.exe" path+"bin/"+name
                      file_copy "file:/bin/tar" path+"bin/tar"
                      # tar extra executables
                      file_copy "file:/bin/gzip" path+"bin/gzip"
                      if lc_user:name=0
                        file_copy "file:/bin/insmod" path+"bin/insmod"
                        file_copy "file:/bin/rmmod" path+"bin/rmmod"
                    part copy_lib
                      file_tree_create path+"lib/"
                      file_copy "file:/lib/libc.so.6" path+"lib/libc.so.6" extended+linktransparent
                      file_copy "file:/lib/libdl.so.2" path+"lib/libdl.so.2" extended+linktransparent
                      file_copy "file:/lib/ld-linux.so.2" path+"lib/ld-linux.so.2" extended+linktransparent
                      file_copy "file:/lib/libm.so.6" path+"lib/libm.so.6" extended+linktransparent
                      file_copy "file:/usr/lib/libz.so.1" path+"lib/libz.so.1" extended+linktransparent
                      file_copy "file:/lib/libz.so.1" path+"lib/libz.so.1" extended+linktransparent
                      file_copy "file:/usr/lib/libjpeg.so" path+"lib/libjpeg.so" extended+linktransparent
                      file_copy "file:/lib/libjpeg.so" path+"lib/libjpeg.so" extended+linktransparent
                      # tar extra DLLs
                      file_copy "file:/lib/libpthread.so.0" path+"lib/libpthread.so.0" extended+linktransparent
                      file_copy "file:/lib/librt.so.1" path+"lib/librt.so.1" extended+linktransparent
                    part create_dev
                      file_tree_create path+"dev/"
                      kernel_make_device path+"dev/null"
                      kernel_make_device path+"dev/random"
                  if lap=0 or lap=3
                    part this_computer_database
                      if not (name parse any:(var Str v_name) "." any:(var Str v_domain))
                        v_name := name ; v_domain := ""
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/identity/name" v_name
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/identity/domain" v_domain
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/http/port" (string lc_http_port:name)
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/remote/service" this_computer:env:"logical":name:"remote"
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/remote/port" (string lc_remote_port:name)
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/cluster/service" this_computer:env:"logical":name:"cluster"
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/cluster/daemon" this_computer:env:"logical":name:"cluster"
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/system/distribution" "fullpliant"
                      data_write path+"pliant_security/this_computer.pdb" "/env/hardware/processor/count" string:processor_count
                      data_write path+"pliant_security/this_computer.pdb" "/env/hardware/processor/model" this_computer:env:"hardware":"processor":"model"
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/memory/assigned" this_computer:env:"logical":name:"memory"
                      data_write path+"pliant_security/this_computer.pdb" "/env/pliant/memory/overflow" this_computer:env:"logical":name:"memory_overflow"
                  if lap=0
                    part users_database
                      var (Link Database:UserDatabase) logical_users :> new Database:UserDatabase
                      logical_users load path+"pliant_security/user.pdb"
                      each u user_database:data:user
                        var CBool admin := false
                        each r u:right
                          if r:right="administrator"
                            admin := true
                        if admin or keyof:u="anonymous"
                          logical_users:data:user create keyof:u
                          data_copy u (logical_users:data:user keyof:u)
                      logical_users store
                    part site_database
                      name_database store
                      file_copy "security:/name.pdb" path+"pliant_security/name.pdb"
                      var (Link Database:NameSecretDatabase) nsdb :> new Database:NameSecretDatabase
                      nsdb load path+"pliant_security/name_secret.pdb"
                      nsdb:data:host create name
                      data_copy name_secret_database:data:host:name nsdb:data:host:name
                      nsdb store
                      var (Link Database:SiteDatabase) sdb :> new Database:SiteDatabase
                      sdb load path+"pliant_security/site.pdb"
                      var (Link Database:SiteSecretDatabase) ssdb :> new Database:SiteSecretDatabase
                      ssdb load path+"pliant_security/site_secret.pdb"
                      each a_site site
                        if a_site:computer=name
                          sdb:data:site create keyof:a_site
                          data_copy site_database:data:site:(keyof a_site) sdb:data:site:(keyof a_site)
                          ssdb:data:site create keyof:a_site
                          data_copy site_secret_database:data:site:(keyof a_site) ssdb:data:site:(keyof a_site)
                      sdb store
                      ssdb store
                  if lap=0
                    part set_rights
                      file_tree_rights path lc_user:name lc_group:name 0 0 0 0
                      file_rights "file:/tmp/" undefined undefined 7*8^2+7*8+7 0
                  reload_page
              cell
                if lap=0
                  [Copy all files from the physical to the logical computer in order to get a working logical computer.]
                eif lap=1
                  [Copy only /bin /lib and others OS related files.]
                eif lap=2
                  [Copy only Pliant tree.]
                eif lap=3
                  [Overwrite only this_computer.pdb]
            cell
              button "Adjust files owner" noeol
                file_tree_rights lc_root:name lc_user:name lc_group:name 0 0 0 0
                reload_page
            cell
              [Logical computers usually run as normal user, not root. This will adjust all the files owner flags in the logical computer so that it owns, so can modify all files in the logical computer.]
            cell
              button "Delete .dump files" noeol
                var Str path := lc_root name
                var Array:FileInfo files := file_list path+"pliant/binary/" standard
                for (var Int i) 0 files:size-1
                  if files:i:extension=".dump"
                    file_delete files:i:name
                reload_page
            cell
              [Drop .dump file so that Pliant will recompile everything the next time it's restarted.]
            cell
              button "Delete all files"
                var Str path := lc_root name
                [You are going to remove all files in ]
                fixed
                  text path
                eol
                [Are you sure that you really want to do that ? ]
                button "yes" noeol
                  file_tree_delete path
                  file_delete "file:/logical/"
                  goto_backward
                button "no"
                  goto_backward
            cell
              [Delete absoluely all logical computer files.]
  cell (italic text:computer_fullname)
  cell
    text (string memory_current_consumed\2^20)+" / "+(string memory_assigned\2^20)+" MB"
    total_used += memory_current_consumed
    total_assigned += memory_assigned
  cell void
  cell void
  cell void
  cell italic:[total]
  cell
    text (string total_used\2^20)+" / "+(string total_assigned\2^20)+" MB"
  cell void
  cell void
  cell void
input "Logical computer name: " (var Str lid) noeol
page button "Create" noeol
  var Int p := 90
  part check_port
    each h name_database:data:host
      if h:physical=computer_fullname and h:http_port=p
      if h:physical=computer_fullname and h:http_port=p or p=110 # 110 is POP3
        p += 10
        restart check_port
  name_database:data:host create lid
  name_database:data:host:lid physical := computer_fullname
  name_database:data:host:lid http_port := p
  name_database:data:host:lid remote_port := remote_tcp_port+(p-80)
  this_computer "logical" lid "automatic" := "false"
  this_computer "logical" lid "cooped" := "true"
  this_computer "logical" lid "remote" := "true"
  this_computer "logical" lid "memory" := string memory_assigned\2\2^20
  reload_page
button "Delete"
  this_computer:env:"logical" delete lid
  name_database:data:host delete lid
  reload_page