31/80: gnu: Add service to start the installer in installation-os.

[John Darrington]

jmd pushed a commit to branch wip-installer
in repository guix.

commit 6dd156ee40e0afd5a3e62a0a32e922fe5887d3d0
Author: John Darrington <address@hidden>
Date:   Sun Dec 25 09:44:25 2016 +0100

    gnu: Add service to start the installer in installation-os.
    
    * gnu/system/install.scm (guix-installer): New procedure,
    (%installation-services): Add guix-installer service on tty1.
---
 gnu/system/install.scm |   36 +++++++++++++++++++++++++++++++++++-
 1 file changed, 35 insertions(+), 1 deletion(-)

diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index ad234fd..06aaca9 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -29,10 +29,12 @@
   #:use-module (gnu packages admin)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages linux)
+  #:use-module (gnu packages pciutils)
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages package-management)
   #:use-module (gnu packages disk)
   #:use-module (gnu packages grub)
+  #:use-module (gnu packages guile)
   #:use-module (gnu packages texinfo)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages nvi)
@@ -119,6 +121,37 @@ manual."
                            "-f" (string-append #$guix "/share/info/guix.info")
                            "-n" "System Installation"))))
 
+(define (guix-installer)
+  "Return a script that spawns the guix installer."
+  (program-file "guix-installer"
+                #~(begin
+                    (setenv "TZDIR"
+                            (string-append #$tzdata "/share/zoneinfo"))
+                    (setenv "PATH"
+                            (string-join
+                             (list
+                              (string-append #$bash       "/bin")
+                              (string-append #$coreutils  "/bin")  ; for ls (!)
+                              (string-append #$e2fsprogs  "/sbin")
+                              (string-append #$iproute    "/sbin")
+                              (string-append #$isc-dhcp   "/sbin")
+                              (string-append #$iw         "/sbin")
+                              (string-append #$kbd        "/bin")
+                              (string-append #$parted     "/sbin")
+                              (string-append #$pciutils   "/sbin")
+                              (string-append #$shepherd   "/bin")  ; for herd
+                              (string-append #$shepherd   "/sbin") ; for reboot
+                              (string-append #$util-linux "/sbin")
+                              (string-append #$wpa-supplicant-minimal   
"/sbin")
+                              (string-append #$which      "/bin"))
+                             ":"))
+                    (setenv "GUILE_LOAD_PATH"
+                            (string-append #$guile-ncurses 
"/share/guile/site/2.0"))
+                    ;; "(current-guix)" should probably be changed to "guix"
+                    ;; at some point.
+                    (execl (string-append #$(current-guix) "/bin/guix")
+                           "guix" "system" "installer"))))
+
 (define %backing-directory
   ;; Sub-directory used as the backing store for copy-on-write.
   "/tmp/guix-inst")
@@ -273,7 +306,8 @@ You have been warned.  Thanks for being so brave.
 
     (list (mingetty-service (mingetty-configuration
                              (tty "tty1")
-                             (auto-login "root")))
+                             (auto-login "root")
+                             (login-program (guix-installer))))
 
           (login-service (login-configuration
                           (motd motd)))