~ruther/guix-local

484a2b3a5ac7337e5d3b8773f6ce8c356b72742b — Ludovic Courtès 11 years ago a9f48ff
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(-)

M gnu/system.scm
M guix/build/activation.scm
M gnu/system.scm => gnu/system.scm +22 -5
@@ 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,

M guix/build/activation.scm => guix/build/activation.scm +4 -14
@@ 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")))