24/44: HACK use uncompiled .scm for shepherd

[guix-commits]

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

commit 8738dc7b4c56f9bd26b86a9182608f30e829f739
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 | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 60 insertions(+), 1 deletion(-)

diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index e387db4..d31091c 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -35,6 +35,7 @@
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services hurd)
+  #:use-module (gnu services shepherd)
   #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:export (cross-hurd-image))
@@ -83,6 +84,58 @@
 (define (hurd-shepherd-services os)
   (append-map hurd-service->shepherd-service (operating-system-services os)))
 
+;;; 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 '#$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))
   "Return a cross-built GNU/Hurd image."
 
@@ -163,8 +216,14 @@ if [ -f \"$GUIX_PROFILE/etc/profile\" ]; then
   . \"$GUIX_PROFILE/etc/profile\"
 fi\n"))
 
+  ;; XXX This still gives 64bit .go files
+  ;; (define shepherd.conf
+  ;;   (with-parameters ((%current-target-system "i586-pc-gnu"))
+  ;;     (shepherd-configuration-file (hurd-shepherd-services %hurd-os))))
+
   (define shepherd.conf
-    (shepherd-configuration-file (hurd-shepherd-services %hurd-os)))
+    (with-parameters ((%current-target-system "i586-pc-gnu"))
+      (hurd-shepherd-configuration-file (hurd-shepherd-services %hurd-os))))
 
   (define hurd-directives
     `((directory "/servers")