/pliant/fullpliant/embedded/install.pli
 
 1  module "/pliant/language/stream.pli" 
 2  module "/pliant/language/stream/filesystembase.pli" 
 3  module "/pliant/language/stream/multi.pli" 
 4  module "/pliant/language/os.pli" 
 5  module "/pliant/language/stream/pipe.pli" 
 6  module "/pliant/admin/file.pli" 
 7  module "/pliant/admin/execute.pli" 
 8  submodule "/pliant/fullpliant/computer.pli" 
 9  module "/pliant/fullpliant/debian.pli" 
 10  module "/pliant/linux/kernel/device.pli" 
 11  module "configure.pli" 
 12  module "compile.pli" 
 13   
 14  public 
 15    constant fullpliant_custom_path "file:/fullpliant/custom/" 
 16  constant force_nonintractive true 
 17  constant secured true 
 18   
 19  constant debian_user (shunt secured 1234 0) 
 20  constant debian_group (shunt secured 1234 0) 
 21  constant configure_timeout 15 
 22   
 23   
 24  function unix_service_pids name -> pids 
 25    arg Str name ; arg Str pids 
 26    pids := "" 
 27    var Array:FileInfo files := file_list "file:/proc/" standard+directories+relative 
 28    for (var Int i) files:size-1 
 29      if (files:i:name parse (var Int pid) "/") 
 30        (var Stream s) open "file:/proc/"+string:pid+"/cmdline" in+safe 
 31        var Str cmd := readline 
 32        cmd := cmd 0 (cmd search "[0]" cmd:len) 
 33        if cmd=name 
 34          pids += " "+string:pid+" " 
 35   
 36  function unix_service_cleanup name pids log 
 37    arg Str name ; arg Str pids ; arg_rw Stream log 
 38    var Array:FileInfo files := file_list "file:/proc/" standard+directories+relative 
 39    for (var Int i) files:size-1 
 40      if (files:i:name parse (var Int pid) "/") 
 41        (var Stream s) open "file:/proc/"+string:pid+"/cmdline" in+safe 
 42        var Str cmd := readline 
 43        cmd := cmd 0 (cmd search "[0]" cmd:len) 
 44        if cmd=name and (pids search " "+string:pid+" " -1)=(-1) 
 45          log writeline " -- killing "+name+" daemon" 
 46          os_kill pid os_SIGKILL 
 47   
 48   
 49  function auto_answer c package0 cmd log -> err 
 50    arg_rw Data:Computer c ; arg Str package0 cmd ; arg_rw Stream log ; arg Int err 
 51    stream_pipe (var Str kbd_in) (var Str kbd_out) 
 52    stream_pipe (var Str con_in) (var Str con_out) 
 53    (var FastSem sem) request 
 54    thread 
 55      share sem log 
 56      var Str kbd_layout := c:env:"hardware":"keyboard":"layout" 
 57      (var Stream con) open con_in in+safe 
 58      (var Stream kbd) open kbd_out out+linecache+safe 
 59      var Str package := package0 ; var Int counter := 0 
 60      while not con:atend 
 61        con configure "timeout 2" 
 62        var Str := con readline 
 63        con configure "timeout ?" 
 64        if (parse word:"Setting" word:"up" any:(var Str pkg) "(" any) 
 65          package := pkg ; counter := 0 
 66        log writeline "   "+l ; console "   " eol 
 67        var Str := "no answer" 
 68        if (parse any "?" any) or (parse any "[lb]" any "[rb]" any) or (parse any ":"or (parse acword:"hit" acword:"enter" any) or (parse acword:"press" acword:"enter" any) 
 69          := "" 
 70        if pkg="console-tools" 
 71          if (parse "What keytable to load" any) 
 72            if (kbd_layout parse any:(var Str head) "/" any:(var Str tail)) 
 73              := head ; kbd_layout := tail 
 74            else 
 75              := kbd_layout ; kbd_layout := "" 
 76          eif (parse "Do you want to test the new keymap right now" any) 
 77            := "n" 
 78          eif (parse any "Do you want changes to take effect right now" any) 
 79            := "n" 
 80        each c:env:"package":package 
 81          if (keyof:parse "question" any:(var Str id)) and (parse any pattern:any) 
 82            := c:env:"package":package "answer"+id 
 83        counter += 1 
 84        if a="no answer" and counter%60=0 
 85          if counter%180=0 
 86            := "1" 
 87          eif counter%180=120 
 88            := "no" 
 89          else 
 90            := "" 
 91        if a<>"no answer" 
 92          log writeline "-> "+a ; console "-> " eol 
 93          kbd writeline a 
 94      sem release  
 95    err := execute cmd root "target:/" path "target:/" input kbd_in output con_out user debian_user group debian_group 
 96    sem request ; sem release 
 97   
 98  function embedded_packages_configure c -> status 
 99    arg_rw Data:Computer c ; arg Status status 
 100    var Str pids := "" 
 101    each c:env:"package" 
 102      each p 
 103        if (keyof:parse "daemon" any) 
 104          pids += unix_service_pids d 
 105    (var Stream log) open "target:/var/log/configure.log" out+linecache 
 106    part configure 
 107      status := success 
 108      for (var Int lap) 1 5 
 109        if force_nonintractive 
 110          var Array:FileInfo frontends := file_list "target:/usr/share/perl5/Debconf/FrontEnd/" standard 
 111          for (var Int i) frontends:size-1 
 112            if frontends:i:name<>"target:/usr/share/perl5/Debconf/FrontEnd/Noninteractive.pm" 
 113              file_delete frontends:i:name 
 114        var Int err := auto_answer "" "dpkg --configure -a" log 
 115        if err=0 
 116          leave configure 
 117        (var Stream packages) open "target:/var/lib/dpkg/status" in+safe 
 118        while not packages:atend 
 119          var Str := packages readline 
 120          if (parse "Package" ":" any:(var Str name)) 
 121            void 
 122          eif (parse "Status" ":" any:(var Str stat)) 
 123            if stat<>"install ok installed" 
 124              console "Force configuring package "+name eol 
 125              auto_answer name "/var/lib/dpkg/info/"+name+".postinst configure" log 
 126      status := failure 
 127    each c:env:"package" 
 128      each p 
 129        if (keyof:parse "daemon" any) 
 130          unix_service_cleanup pids log 
 131   
 132   
 133  function file_switch_owner info from_user from_group to_user to_group -> count 
 134    arg FileInfo info ; arg Int from_user from_group to_user to_group ; arg Int count 
 135    count := 0 
 136    if (info:options option "uid" Int undefined)=from_user 
 137      file_rights info:name to_user undefined 0 0 ; count += 1 
 138    if (info:options option "gid" Int undefined)=from_group 
 139      file_rights info:name undefined to_group 0 0 
 140   
 141  function process_kill_user uid 
 142    arg Int uid 
 143    var Array:FileInfo all := file_list "file:/proc/" standard+relative+directories 
 144    for (var Int i) all:size-1 
 145      if (all:i:name parse (var Int pid) "/") 
 146        (var Stream s) open "file:/proc/"+string:pid+"/status" in+safe 
 147        var Str name := "" ; var Int ppid := undefined 
 148        while not s:atend 
 149          var Str := readline 
 150          if (parse "Name:" any:(var Str str)) 
 151            name := str 
 152          if (parse "Uid:" (var Int num) any) and num=uid 
 153            console "killing " name eol 
 154            os_kill pid os_SIGKILL 
 155   
 156   
 157  function embedded_debian_configure c -> status 
 158    arg_rw Data:Computer c ; arg Status status 
 159    # remove inetd (who knows what it may launch) 
 160    file_delete "target:/usr/sbin/inetd" 
 161    # packages list 
 162    if (file_query "target:/var/lib/dpkg/available" standard)=undefined 
 163      (var Stream s) open "target:/var/lib/dpkg/available" out 
 164      close 
 165    # dynamic libraries 
 166    file_move "target:/sbin/ldconfig.new" "target:/sbin/ldconfig" 
 167    if (file_query "target:/etc/ld.so.conf" standard)=undefined 
 168      (var Stream s) open "target:/etc/ld.so.conf" out 
 169      writeline "/usr/X11R6/lib" 
 170      writeline "/usr/local/lib" 
 171    # sh 
 172    if (file_query "target:/bin/sh" standard)=undefined 
 173      file_link "file:bash" "target:/bin/sh" 
 174    # awk 
 175    if (file_query "target:/usr/bin/awk" standard)=undefined 
 176      file_link "file:/usr/bin/mawk" "target:/usr/bin/awk" 
 177    # perl 
 178    if (file_query "target:/usr/bin/perl" extended)=undefined 
 179      var Array:FileInfo files := file_list "target:/usr/bin/" standard+relative 
 180      for (var Int i) files:size-1 
 181        if (files:i:name parse "perl" (var Float f)) 
 182          file_link "file:/usr/bin/"+files:i:name "target:/usr/bin/perl" 
 183    if secured 
 184      var Int count := 0 
 185      count += file_switch_owner (file_query "target:/" extended) 0 0 debian_user debian_group 
 186      var Array:FileInfo files := file_list "target:/" extended+recursive+directories 
 187      for (var Int i) files:size-1 
 188        count += file_switch_owner files:0 0 debian_user debian_group 
 189      console "changed owner of " count " files" eol 
 190    # generate devices 
 191    if not secured 
 192      execute "MAKEDEV generic" path "target:/dev/" 
 193    kernel_make_device "target:/dev/null" 
 194    if (exists c:env:"package":"libraw1394-5") 
 195      kernel_make_device "target:/dev/raw1394" 
 196    if false # these should be configured by Debian dpkg but are not because of a bug in Debian perl script 
 197      # tk 
 198      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 
 199      # mozilla 
 200      execute "update-mozilla-chrome" root "target:/" path "target:/" user debian_user group debian_group 
 201      var Array:FileInfo files := file_list "target:/usr/bin/" standard+relative 
 202      for (var Int i) 0 files:size-1 
 203        files:i:name parse "mozilla-bin-" any:(var Str mozilla_version) 
 204      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 
 205    # now run Debian packages configuration scripts 
 206    status := embedded_packages_configure c 
 207    if secured 
 208      for (var Int lap) 1 5 
 209        var Array:FileInfo files := file_list "target:/var/lib/dpkg/info/" standard 
 210        for (var Int i) files:size-1 
 211          if files:i:extension=".preinst" 
 212            console "installing " files:i:stripped_name " (lap " lap ")" eol 
 213            execute "/var/lib/dpkg/info/"+files:i:stripped_name+".preinst install" root "target:/" path "target:/" user debian_user group debian_group 
 214        for (var Int i) files:size-1 
 215          if files:i:extension=".postinst" 
 216            console "configuring " files:i:stripped_name " (lap " lap ")" eol 
 217            var Link:CBool done :> new CBool false 
 218            var Link:CBool ack :> new CBool false 
 219            var Float slice := 0.025 
 220            thread 
 221              var Int counter := 0 
 222              while not done and counter<(cast configure_timeout/slice Int) 
 223                sleep slice 
 224                counter += 1 
 225              if not done 
 226                process_kill_user debian_user 
 227              ack := true 
 228            execute "/var/lib/dpkg/info/"+files:i:stripped_name+".postinst configure" root "target:/" path "target:/" user debian_user group debian_group 
 229            done := true 
 230            while not ack 
 231              sleep slice 
 232        process_kill_user debian_user 
 233    # cleanup 
 234    file_delete "target:/initrd/" 
 235    file_delete "target:/cdrom/" 
 236    file_delete "target:/floppy/" 
 237    if secured 
 238      var Int count := 0 
 239      count += file_switch_owner (file_query "target:/" extended) debian_user debian_group 0 0 
 240      var Array:FileInfo files := file_list "target:/" extended+recursive+directories 
 241      for (var Int i) files:size-1 
 242        count += file_switch_owner files:debian_user debian_group 0 0 
 243      console "reverted owner of " count " files" eol 
 244   
 245   
 246 
 
 247   
 248   
 249  function embedded_download c -> status 
 250    arg_rw Data:Computer c ; arg Status status 
 251    status := success 
 252    plugin pre_download 
 253    each sw c:env:"software" 
 254      var Str appli := keyof sw 
 255      if (exists c:env:"software":appli:"download"and (exists c:env:"software":appli:"version") 
 256        var Str version := c:env:"software":appli:"version" 
 257        var Str remote := replace c:env:"software":appli:"download" "*" version 
 258        var Str sname := remote (remote search_last "/" -1)+remote:len 
 259        var Str local := "file:/fullpliant/unix/src/"+sname 
 260        if (file_query local standard)=undefined 
 261          console "  download " sname " " 
 262          if (file_copy remote local)=success 
 263            console "ok" eol 
 264          else 
 265            console "FAILED" eol 
 266            status := failure 
 267    plugin post_download 
 268   
 269   
 270  function embedded_install c path 
 271    arg_rw Data:Computer c ; arg Str path 
 272    pliant_multi_file_system mount "target:/" path pliant_default_file_system 
 273    console "Unpacking Debian packages" eol 
 274    (var DebianDistribution debian) bind c 
 275    plugin pre_unpack 
 276    each c:env:"package" 
 277      var Str name := keyof p 
 278      console "  " name eol 
 279      if (debian unpack name p:"file" "target:/")=failure 
 280        console "Failed to unpack package " name " " p:"version" eol 
 281    (var Stream s) open "target:/var/lib/dpkg/available" out 
 282    close 
 283    plugin post_unpack 
 284    console "Configuring Debian packages" eol 
 285    embedded_configure true 
 286    embedded_debian_configure c 
 287    console "Copying custom files" eol 
 288    file_tree_copy fullpliant_custom_path "target:/" 
 289    plugin pre_compile 
 290    embedded_compile c 
 291    plugin post_compile 
 292    file_tree_delete "target:/usr/src/" 
 293    file_tree_create "target:/usr/src/" 
 294    plugin pre_configure 
 295    embedded_configure true 
 296    plugin post_configure 
 297    pliant_multi_file_system dismount "target:/" 
 298   
 299   
 300  export embedded_download embedded_install 
 301