36/36: HACK use uncompiled .scm for shepherd

[guix-commits]

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

commit 6c9efcd45e6ef993b5144c178f532893ce036c7b
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Mon Apr 13 12:22:45 2020 +0200

    HACK use uncompiled .scm for shepherd
    
    XXX scm->go compiles for build, not host.  Hack around that by loading .SCM
    instead of .GO in shepherd-configuration.
    
    * gnu/system/hurd.scm (hurd-shepherd-configuration-file): New function.  
Copy
    from shepherd-configuration-file: remove scm->go, use load instead of
    load-compiled.
---
 gnu/system/hurd.scm | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 67 insertions(+), 1 deletion(-)

diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 5d9d102..36ef687 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -185,6 +185,67 @@ fi\n")))
 (define (hurd-shepherd-services os)
   (append-map hurd-service->shepherd-service (operating-system-services os)))
 
+;; (use-modules (system base target))
+;; (define (scm->go file)
+;;   (with-target "i586-pc-gnu"
+;;     (lambda _
+;;       ((@@ (gnu services shepherd) scm->go) file))))
+
+;;; XXX Try uncompiled .scm files; .GOs have build architecture.
+(define (hurd-shepherd-configuration-file services)
+  "Return the shepherd configuration file for SERVICES."
+  ((@@ (gnu services shepherd) assert-valid-graph) services)
+
+  (let ((files (map shepherd-service-file services)))
+    (define config
+      #~(begin
+          (use-modules (srfi srfi-34)
+                       (system repl error-handling))
+
+          ;; Specify the default environment visible to all the services.
+          ;; Without this statement, all the environment variables of PID 1
+          ;; are inherited by child services.
+          (default-environment-variables
+            '("PATH=/run/current-system/profile/bin"))
+
+          ;; Arrange to spawn a REPL if something goes wrong.  This is better
+          ;; than a kernel panic.
+          (call-with-error-handling
+            (lambda ()
+              ;; (apply register-services
+              ;;        (map load-compiled '#$(map scm->go files)))
+              (apply register-services
+                     (map load '#$files))
+              ))
+
+          (format #t "starting services...~%")
+          (for-each (lambda (service)
+                      ;; In the Shepherd 0.3 the 'start' method can raise
+                      ;; '&action-runtime-error' if it fails, so protect
+                      ;; against it.  (XXX: 'action-runtime-error?' is not
+                      ;; exported is 0.3, hence 'service-error?'.)
+                      (guard (c ((service-error? c)
+                                 (format (current-error-port)
+                                         "failed to start service '~a'~%"
+                                         service)))
+                        (start service)))
+                    '#$(append-map shepherd-service-provision
+                                   (filter shepherd-service-auto-start?
+                                           services)))
+
+          ;; Hang up stdin.  At this point, we assume that 'start' methods
+          ;; that required user interaction on the console (e.g.,
+          ;; 'cryptsetup open' invocations, post-fsck emergency REPL) have
+          ;; completed.  User interaction becomes impossible after this
+          ;; call; this avoids situations where services wrongfully lead
+          ;; PID 1 to read from stdin (the console), which users may not
+          ;; have access to (see <https://bugs.gnu.org/23697>).
+          (redirect-port (open-input-file "/dev/null")
+                         (current-input-port))))
+
+    (scheme-file "shepherd.conf" config)))
+
+
 (define* (cross-hurd-image #:key (hurd hurd) (gnumach gnumach) (os %hurd-os))
   "Return a cross-built GNU/Hurd image."
 
@@ -267,9 +328,14 @@ sshd:x:2:2:sshd:/var/empty:/bin/no-sh
                 "root::17873::::::
 "))
 
+  ;; XXX This still gives 64bit .go files
+  ;; (define shepherd.conf
+  ;;   (with-parameters ((%current-target-system "i586-pc-gnu"))
+  ;;     (shepherd-configuration-file (hurd-shepherd-services os))))
+
   (define shepherd.conf
     (with-parameters ((%current-target-system "i586-pc-gnu"))
-      (shepherd-configuration-file (hurd-shepherd-services os))))
+      (hurd-shepherd-configuration-file (hurd-shepherd-services os))))
 
   (define boot-activation
     (with-parameters ((%current-target-system "i586-pc-gnu"))