From 63b0ce391f6ea79012fac893e933e39d7a16abbd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 6 Oct 2019 12:51:33 +0200 Subject: services: shepherd: Compile service files. This reduces resident memory for PID 1 from 29.8MiB to 28.7MiB right after boot on a bare-bones system (x86_64-linux). * gnu/services/shepherd.scm (scm->go): New procedure. (shepherd-configuration-file)[config]: Call it and use 'load-compiled' instead of 'primitive-load'. --- gnu/services/shepherd.scm | 77 +++++++++++++++++++++++++++++------------------ 1 file changed, 47 insertions(+), 30 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index 45c67e04eb..08bb33039c 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -255,6 +255,22 @@ stored." #~(#$name #$doc #$proc))) (shepherd-service-actions service)))))))) +(define (scm->go file) + "Compile FILE, which contains code to be loaded by shepherd's config file, +and return the resulting '.go' file." + (with-extensions (list shepherd) + (computed-file (string-append (basename (scheme-file-name file) ".scm") + ".go") + #~(begin + (use-modules (system base compile)) + + ;; Do the same as the Shepherd's 'load-in-user-module'. + (let ((env (make-fresh-user-module))) + (module-use! env (resolve-interface '(oop goops))) + (module-use! env (resolve-interface '(shepherd service))) + (compile-file #$file #:output-file #$output + #:env env)))))) + (define (shepherd-configuration-file services) "Return the shepherd configuration file for SERVICES." (assert-valid-graph services) @@ -269,36 +285,37 @@ stored." ;; than a kernel panic. (call-with-error-handling (lambda () - (apply register-services (map primitive-load '#$files)) - - ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around - ;; it. - (setenv "PATH" "/run/current-system/profile/bin") - - (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 ). - (redirect-port (open-input-file "/dev/null") - (current-input-port)))))) + (apply register-services + (map load-compiled '#$(map scm->go files))))) + + ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around + ;; it. + (setenv "PATH" "/run/current-system/profile/bin") + + (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 ). + (redirect-port (open-input-file "/dev/null") + (current-input-port)))) (scheme-file "shepherd.conf" config))) -- cgit 1.4.1