Patch title: Release 90 bulk changes
Abstract:
File: /fullpliant/embedded/install.pli
Key:
    Removed line
    Added line
module "/pliant/language/stream.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/stream/multi.pli"
module "/pliant/language/os.pli"
module "/pliant/language/stream/pipe.pli"
module "/pliant/admin/file.pli"
module "/pliant/admin/execute.pli"
submodule "/pliant/fullpliant/computer.pli"
module "/pliant/fullpliant/debian.pli"
module "/pliant/linux/kernel/device.pli"
module "configure.pli"
module "compile.pli"

public
  constant fullpliant_custom_path "file:/fullpliant/custom/"
constant force_nonintractive true
constant secured true

constant debian_user (shunt secured 1234 0)
constant debian_group (shunt secured 1234 0)
constant configure_timeout 15


function unix_service_pids name -> pids
  arg Str name ; arg Str pids
  pids := ""
  var Array:FileInfo files := file_list "file:/proc/" standard+directories+relative
  for (var Int i) 0 files:size-1
    if (files:i:name parse (var Int pid) "/")
      (var Stream s) open "file:/proc/"+string:pid+"/cmdline" in+safe
      var Str cmd := s readline
      cmd := cmd 0 (cmd search "[0]" cmd:len)
      if cmd=name
        pids += " "+string:pid+" "

function unix_service_cleanup name pids log
  arg Str name ; arg Str pids ; arg_rw Stream log
  var Array:FileInfo files := file_list "file:/proc/" standard+directories+relative
  for (var Int i) 0 files:size-1
    if (files:i:name parse (var Int pid) "/")
      (var Stream s) open "file:/proc/"+string:pid+"/cmdline" in+safe
      var Str cmd := s readline
      cmd := cmd 0 (cmd search "[0]" cmd:len)
      if cmd=name and (pids search " "+string:pid+" " -1)=(-1)
        log writeline " -- killing "+name+" daemon"
        os_kill pid os_SIGKILL


function auto_answer c package0 cmd log -> err
  arg_rw Data:Computer c ; arg Str package0 cmd ; arg_rw Stream log ; arg Int err
  stream_pipe (var Str kbd_in) (var Str kbd_out)
  stream_pipe (var Str con_in) (var Str con_out)
  (var FastSem sem) request
  thread
    share sem log
    var Str kbd_layout := c:env:"hardware":"keyboard":"layout"
    (var Stream con) open con_in in+safe
    (var Stream kbd) open kbd_out out+linecache+safe
    var Str package := package0 ; var Int counter := 0
    while not con:atend
      con configure "timeout 2"
      var Str l := con readline
      con configure "timeout ?"
      if (l parse word:"Setting" word:"up" any:(var Str pkg) "(" any)
        package := pkg ; counter := 0
      log writeline "   "+l ; console "   " l eol
      var Str a := "no answer"
      if (l parse any "?" any) or (l parse any "[lb]" any "[rb]" any) or (l parse any ":") or (l parse acword:"hit" acword:"enter" any) or (l parse acword:"press" acword:"enter" any)
        a := ""
      if pkg="console-tools"
        if (l parse "What keytable to load" any)
          if (kbd_layout parse any:(var Str head) "/" any:(var Str tail))
            a := head ; kbd_layout := tail
          else
            a := kbd_layout ; kbd_layout := ""
        eif (l parse "Do you want to test the new keymap right now" any)
          a := "n"
        eif (l parse any "Do you want changes to take effect right now" any)
          a := "n"
      each r c:env:"package":package
        if (keyof:r parse "question" any:(var Str id)) and (l parse any pattern:r any)
          a := c:env:"package":package "answer"+id
      counter += 1
      if a="no answer" and counter%60=0
        if counter%180=0
          a := "1"
        eif counter%180=120
          a := "no"
        else
          a := ""
      if a<>"no answer"
        log writeline "-> "+a ; console "-> " a eol
        kbd writeline a
    sem release 
  err := execute cmd root "target:/" path "target:/" input kbd_in output con_out user debian_user group debian_group
  sem request ; sem release

function embedded_packages_configure c -> status
  arg_rw Data:Computer c ; arg Status status
  var Str pids := ""
  each p c:env:"package"
    each d p
      if (keyof:d parse "daemon" any)
        pids += unix_service_pids d
  (var Stream log) open "target:/var/log/configure.log" out+linecache
  part configure
    status := success
    for (var Int lap) 1 5
      if force_nonintractive
        var Array:FileInfo frontends := file_list "target:/usr/share/perl5/Debconf/FrontEnd/" standard
        for (var Int i) 0 frontends:size-1
          if frontends:i:name<>"target:/usr/share/perl5/Debconf/FrontEnd/Noninteractive.pm"
            file_delete frontends:i:name
      var Int err := auto_answer c "" "dpkg --configure -a" log
      if err=0
        leave configure
      (var Stream packages) open "target:/var/lib/dpkg/status" in+safe
      while not packages:atend
        var Str l := packages readline
        if (l parse "Package" ":" any:(var Str name))
          void
        eif (l parse "Status" ":" any:(var Str stat))
          if stat<>"install ok installed"
            console "Force configuring package "+name eol
            auto_answer c name "/var/lib/dpkg/info/"+name+".postinst configure" log
    status := failure
  each p c:env:"package"
    each d p
      if (keyof:d parse "daemon" any)
        unix_service_cleanup d pids log


function file_switch_owner info from_user from_group to_user to_group -> count
  arg FileInfo info ; arg Int from_user from_group to_user to_group ; arg Int count
  count := 0
  if (info:options option "uid" Int undefined)=from_user
    file_rights info:name to_user undefined 0 0 ; count += 1
  if (info:options option "gid" Int undefined)=from_group
    file_rights info:name undefined to_group 0 0

function process_kill_user uid
  arg Int uid
  var Array:FileInfo all := file_list "file:/proc/" standard+relative+directories
  for (var Int i) 0 all:size-1
    if (all:i:name parse (var Int pid) "/")
      (var Stream s) open "file:/proc/"+string:pid+"/status" in+safe
      var Str name := "" ; var Int ppid := undefined
      while not s:atend
        var Str l := s readline
        if (l parse "Name:" any:(var Str str))
          name := str
        if (l parse "Uid:" (var Int num) any) and num=uid
          console "killing " name eol
          os_kill pid os_SIGKILL


function embedded_debian_configure c -> status
  arg_rw Data:Computer c ; arg Status status
  # remove inetd (who knows what it may launch)
  file_delete "target:/usr/sbin/inetd"
  # packages list
  if (file_query "target:/var/lib/dpkg/available" standard)=undefined
    (var Stream s) open "target:/var/lib/dpkg/available" out
    s close
  # dynamic libraries
  file_move "target:/sbin/ldconfig.new" "target:/sbin/ldconfig"
  if (file_query "target:/etc/ld.so.conf" standard)=undefined
    (var Stream s) open "target:/etc/ld.so.conf" out
    s writeline "/usr/X11R6/lib"
    s writeline "/usr/local/lib"
  # sh
  if (file_query "target:/bin/sh" standard)=undefined
    file_link "file:bash" "target:/bin/sh"
  # awk
  if (file_query "target:/usr/bin/awk" standard)=undefined
    file_link "file:/usr/bin/mawk" "target:/usr/bin/awk"
  # perl
  if (file_query "target:/usr/bin/perl" extended)=undefined
    var Array:FileInfo files := file_list "target:/usr/bin/" standard+relative
    for (var Int i) 0 files:size-1
      if (files:i:name parse "perl" (var Float f))
        file_link "file:/usr/bin/"+files:i:name "target:/usr/bin/perl"
  if secured
    var Int count := 0
    count += file_switch_owner (file_query "target:/" extended) 0 0 debian_user debian_group
    var Array:FileInfo files := file_list "target:/" extended+recursive+directories
    for (var Int i) 0 files:size-1
      count += file_switch_owner files:i 0 0 debian_user debian_group
    console "changed owner of " count " files" eol
  # generate devices
  if not secured
    execute "MAKEDEV generic" path "target:/dev/"
  kernel_make_device "target:/dev/null"
  if (exists c:env:"package":"libraw1394-5")
    kernel_make_device "target:/dev/raw1394"
  if false # these should be configured by Debian dpkg but are not because of a bug in Debian perl script
    # tk
    execute "update-alternatives --install /usr/bin/tclsh tclsh /usr/bin/tclsh8.0 800 --slave /usr/share/man/man1/tclsh.1.gz tclsh.1 /usr/share/man/man1/tclsh8.0.1.gz" root "target:/" path "target:/" user debian_user group debian_group
    # mozilla
    execute "update-mozilla-chrome" root "target:/" path "target:/" user debian_user group debian_group
    var Array:FileInfo files := file_list "target:/usr/bin/" standard+relative
    for (var Int i) 0 files:size-1
      files:i:name parse "mozilla-bin-" any:(var Str mozilla_version)
    execute "update-alternatives --install /usr/bin/mozilla mozilla /usr/bin/mozilla-"+mozilla_version+" 50 --slave /usr/share/man/man1/mozilla.1.gz mozilla.1.gz /usr/share/man/man1/mozilla-"+mozilla_version+".1.gz --slave /usr/bin/mozilla-bin mozilla-bin /usr/bin/mozilla-bin-"+mozilla_version+" --slave /usr/share/man/man1/mozilla-bin.1.gz mozilla-bin.1.gz /usr/share/man/man1/mozilla-bin-"+mozilla_version+".1.gz" root "target:/" path "target:/" user debian_user group debian_group
  # now run Debian packages configuration scripts
  status := embedded_packages_configure c
  if secured
    for (var Int lap) 1 5
      var Array:FileInfo files := file_list "target:/var/lib/dpkg/info/" standard
      for (var Int i) 0 files:size-1
        if files:i:extension=".preinst"
          console "installing " files:i:stripped_name " (lap " lap ")" eol
          execute "/var/lib/dpkg/info/"+files:i:stripped_name+".preinst install" root "target:/" path "target:/" user debian_user group debian_group
      for (var Int i) 0 files:size-1
        if files:i:extension=".postinst"
          console "configuring " files:i:stripped_name " (lap " lap ")" eol
          var Link:CBool done :> new CBool false
          var Link:CBool ack :> new CBool false
          var Float slice := 0.025
          thread
            var Int counter := 0
            while not done and counter<(cast configure_timeout/slice Int)
              sleep slice
              counter += 1
            if not done
              process_kill_user debian_user
            ack := true
          execute "/var/lib/dpkg/info/"+files:i:stripped_name+".postinst configure" root "target:/" path "target:/" user debian_user group debian_group
          done := true
          while not ack
            sleep slice
      process_kill_user debian_user
  # cleanup
  file_delete "target:/initrd/"
  file_delete "target:/cdrom/"
  file_delete "target:/floppy/"
  if secured
    var Int count := 0
    count += file_switch_owner (file_query "target:/" extended) debian_user debian_group 0 0
    var Array:FileInfo files := file_list "target:/" extended+recursive+directories
    for (var Int i) 0 files:size-1
      count += file_switch_owner files:i debian_user debian_group 0 0
    console "reverted owner of " count " files" eol


#--------------------------------------------------------------------


function embedded_download c -> status
  arg_rw Data:Computer c ; arg Status status
  status := success
  plugin pre_download
  each sw c:env:"software"
    var Str appli := keyof sw
    if (exists c:env:"software":appli:"download") and (exists c:env:"software":appli:"version")
      var Str version := c:env:"software":appli:"version"
      var Str remote := replace c:env:"software":appli:"download" "*" version
      var Str sname := remote (remote search_last "/" -1)+1 remote:len
      var Str local := "file:/fullpliant/unix/src/"+sname
      if (file_query local standard)=undefined
        console "  download " sname " "
        if (file_copy remote local)=success
          console "ok" eol
        else
          console "FAILED" eol
          status := failure
  plugin post_download


function embedded_install c path
  arg_rw Data:Computer c ; arg Str path
  pliant_multi_file_system mount "target:/" path pliant_default_file_system
  console "Unpacking Debian packages" eol
  (var DebianDistribution debian) bind c
  plugin pre_unpack
  each p c:env:"package"
    var Str name := keyof p
    console "  " name eol
    if (debian unpack name p:"file" "target:/")=failure
      console "Failed to unpack package " name " " p:"version" eol
  (var Stream s) open "target:/var/lib/dpkg/available" out
  s close
  plugin post_unpack
  console "Configuring Debian packages" eol
  embedded_configure c true
  embedded_debian_configure c
  console "Copying custom files" eol
  file_tree_copy fullpliant_custom_path "target:/"
  plugin pre_compile
  embedded_compile c
  plugin post_compile
  file_tree_delete "target:/usr/src/"
  file_tree_create "target:/usr/src/"
  plugin pre_configure
  embedded_configure c true
  plugin post_configure
  pliant_multi_file_system dismount "target:/"


export embedded_download embedded_install