mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -05:00
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.
This commit is contained in:
parent
a9f48ff076
commit
484a2b3a5a
2 changed files with 26 additions and 19 deletions
|
@ -348,9 +348,10 @@ (define (user-account->gexp account)
|
|||
,#$(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 @@ (define %modules
|
|||
(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 @@ (define group-specs
|
|||
(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,
|
||||
|
|
|
@ -197,29 +197,19 @@ (define (make-setuid-program prog)
|
|||
|
||||
(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")))
|
||||
|
|
Loading…
Reference in a new issue