system: Separate the activation script from the boot script.

* gnu/system.scm (operating-system-activation-script): New procedure,
  containing most of the former 'operating-system-boot-script'.
  (operating-system-boot-script): Call it, and 'primitive-load' its
  result.
* guix/build/activation.scm (%booted-system): Remove.
  (activate-current-system): Remove #:boot? parameter and related code.

2 files changed, 26 insertions, 19 deletions

diff --git a/gnu/system.scm b/gnu/system.scm
index 6cb7d303db..1d708179bd 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -348,9 +348,10 @@ alias ll='ls -l'
       ,#$(user-account-shell account)             ; this one is a gexp
       #$(user-account-password account)))
 
-(define (operating-system-boot-script os)
-  "Return the boot script for OS---i.e., the code started by the initrd once
-we're running in the final root."
+(define (operating-system-activation-script os)
+  "Return the activation script for OS---i.e., the code that \"activates\" the
+stateful part of OS, including user accounts and groups, special directories,
+etc."
   (define %modules
     '((guix build activation)
       (guix build utils)
@@ -360,7 +361,6 @@ we're running in the final root."
                        (etc      (operating-system-etc-directory os))
                        (modules  (imported-modules %modules))
                        (compiled (compiled-modules %modules))
-                       (dmd-conf (dmd-configuration-file services))
                        (accounts (operating-system-accounts os)))
     (define setuid-progs
       (operating-system-setuid-programs os))
@@ -399,7 +399,24 @@ we're running in the final root."
                     (activate-setuid-programs (list #$@setuid-progs))
 
                     ;; Set up /run/current-system.
-                    (activate-current-system #:boot? #t)
+                    (activate-current-system)))))
+
+(define (operating-system-boot-script os)
+  "Return the boot script for OS---i.e., the code started by the initrd once
+we're running in the final root."
+  (mlet* %store-monad ((services (operating-system-services os))
+                       (activate (operating-system-activation-script os))
+                       (dmd-conf (dmd-configuration-file services)))
+    (gexp->file "boot"
+                #~(begin
+                    ;; Activate the system.
+                    ;; TODO: Use 'load-compiled'.
+                    (primitive-load #$activate)
+
+                    ;; Keep track of the booted system.
+                    (false-if-exception (delete-file "/run/booted-system"))
+                    (symlink (readlink "/run/current-system")
+                             "/run/booted-system")
 
                     ;; Close any remaining open file descriptors to be on the
                     ;; safe side.  This must be the very last thing we do,
diff --git a/guix/build/activation.scm b/guix/build/activation.scm
index 49f98c021d..62e69a9152 100644
--- a/guix/build/activation.scm
+++ b/guix/build/activation.scm
@@ -197,29 +197,19 @@ numeric gid or #f."
 
   (for-each make-setuid-program programs))
 
-(define %booted-system
-  ;; The system we booted in (a symlink.)
-  "/run/booted-system")
-
 (define %current-system
   ;; The system that is current (a symlink.)  This is not necessarily the same
-  ;; as %BOOTED-SYSTEM, for instance because we can re-build a new system
-  ;; configuration and activate it, without rebooting.
+  ;; as the system we booted (aka. /run/booted-system) because we can re-build
+  ;; a new system configuration and activate it, without rebooting.
   "/run/current-system")
 
 (define (boot-time-system)
   "Return the '--system' argument passed on the kernel command line."
   (find-long-option "--system" (linux-command-line)))
 
-(define* (activate-current-system #:optional (system (boot-time-system))
-                                  #:key boot?)
-  "Atomically make SYSTEM the current system.  When BOOT? is true, also make
-it the booted system."
+(define* (activate-current-system #:optional (system (boot-time-system)))
+  "Atomically make SYSTEM the current system."
   (format #t "making '~a' the current system...~%" system)
-  (when boot?
-    (when (file-exists? %booted-system)
-      (delete-file %booted-system))
-    (symlink system %booted-system))
 
   ;; Atomically make SYSTEM current.
   (let ((new (string-append %current-system ".new")))