05/06: squash! gnu: hurd: Create minimal "runsystem" script to invoke "rc".

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit 546d6cbff3634cde14b13ca626593882b984a2da
Author: Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
AuthorDate: Sat May 30 12:12:24 2020 +0200

    squash! gnu: hurd: Create minimal "runsystem" script to invoke "rc".
---
 gnu/packages/hurd.scm | 82 +++++++++++++++++++++++++++------------------------
 1 file changed, 43 insertions(+), 39 deletions(-)

diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index 9f3e945..bbeb550 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -329,11 +329,27 @@ boot, since this cannot be done from GNU/Linux."
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils)
-                       (ice-9 match))
+                       (ice-9 match)
+                       (system repl repl)
+                       (srfi srfi-1)
+                       (srfi srfi-26))
+
+          (display "Welcome, this is GNU's early boot Guile.\n")
+          (display "Use '--repl' for an initrd REPL.\n\n")
 
           ;; "@HURD@" and "@COREUTILS@" are a placeholders.
           (setenv "PATH" "@HURD@/bin:@HURD@/sbin:@COREUTILS@/bin")
 
+          ;; XXX FIXME c&p from linux-boot.scm
+          (define (find-long-option option arguments)
+            "Find OPTION among ARGUMENTS, where OPTION is something like 
\"--load\".
+Return the value associated with OPTION, or #f on failure."
+            (let ((opt (string-append option "=")))
+              (and=> (find (cut string-prefix? opt <>)
+                           arguments)
+                     (lambda (arg)
+                       (substring arg (+ 1 (string-index arg #\=)))))))
+
           (define (translated? node)
             ;; Return true if a translator is installed on NODE.
             (with-output-to-port (%make-void-port "w")
@@ -364,49 +380,37 @@ boot, since this cannot be done from GNU/Linux."
             (invoke "MAKEDEV" "--devdir=/dev" "vcs")
             (invoke "MAKEDEV" "--devdir=/dev" "tty1""tty2" "tty3" "tty4" 
"tty5" "tty6")
             (invoke "MAKEDEV" "--devdir=/dev" "ptyp0" "ptyp1" "ptyp2")
-            (invoke "MAKEDEV" "--devdir=/dev" "std")
             (invoke "MAKEDEV" "--devdir=/dev" "console"))
 
-          ;; Setting current system
-          (unless (file-exists? "/run/current-system/profile")
-            (format #t "Setting current system...\n")
-            (mkdir-p "/run/current-system")
-            (let ((profiles (find-files "/gnu/store"
-                                        (lambda (name stat)
-                                          (and (string-suffix? "-profile" name)
-                                               (eq? 'directory (stat:type 
stat))))
-                                        #:directories? #t)))
-              (when (> (length profiles) 1)
-                (format #t "Too many profiles found...choosing first!\n"))
-              (if (null? profiles)
-                  (format #t "No profiles found...Good luck!\n")
-                  (symlink (car profiles) "/run/current-system/profile"))))
-
-          ;; Start console?
-          (system* "/run/current-system/profile/bin/bash" "-c" "echo 
1>/dev/console")
-
           (format #t "Starting pager...\n")
           (unless (zero? (system* "/hurd/mach-defpager"))
             (format #t "FAILED...Good luck!\n"))
 
-          ;; XXX Activate the system
-          (format #t "Activating system...\n")
-          ;; XXX (primitive-load "/boot/activation")
-          (invoke "/run/current-system/profile/bin/bash" "/boot/activation")
-          ;; Hand over to the Shepherd
-          (let ((shepherd.conf
-                 (if (file-exists? "/etc/shepherd.conf")
-                     "/etc/shepherd.conf"
-                     (let ((files (find-files "/gnu/store" 
".*-shepherd.conf")))
-                       (and (pair? files) (car files))))))
-            (unless shepherd.conf
-              (format #t "No shepherd.conf found, dropping to a shell...\n")
-              (invoke "/run/current-system/profile/bin/bash")
-              (reboot))
-            (false-if-exception (delete-file "/var/run/shepherd/socket"))
-            (format #t "Starting the Shepherd... ~a\n" shepherd.conf)
-            (execl "/run/current-system/profile/bin/shepherd" "shepherd"
-                   "--config" shepherd.conf)))))
+          (let* ((args    (command-line))
+                 (system  (find-long-option "--system" args))
+                 (to-load (find-long-option "--load" args)))
+            (false-if-exception (delete-file "/run/current-system"))
+            (format #t "Setting current system...~a\n" system)
+            (mkdir-p "/run")
+            (symlink system "/run/current-system")
+            (cond ((member "--repl" args)
+                   (start-repl))
+                  (to-load
+                   ;; TODO
+                   ;;(switch-root "/root")
+                   (format #t "loading '~a'...\n" to-load)
+                   
+                   (primitive-load to-load)
+
+                   (format (current-error-port)
+                           "boot program '~a' terminated, rebooting~%"
+                           to-load)
+                   (sleep 2)
+                   (reboot))
+                  (else
+                   (display "no boot file passed via '--load'\n")
+                   (display "entering a warm and cozy REPL\n")
+                   (start-repl)))))))
 
   ;; FIXME: We want the program to use the cross-compiled Guile when
   ;; cross-compiling.  But why do we need to be explicit here?
@@ -495,7 +499,7 @@ fsck --yes --force /
 fsysopts / --writable
 settrans -c /servers/socket/1 /hurd/pflocal
 echo Starting /libexec/rc ...
-exec /libexec/rc
+exec /libexec/rc \"$@\"
 ")))
              ))