diff --git a/gnu/system.scm b/gnu/system.scm index 89c4150f9..5f20e8ab5 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -73,7 +73,7 @@ operating-system-hosts-file operating-system-kernel operating-system-kernel-file - operating-system-kernel-arguments + operating-system-all-kernel-arguments operating-system-initrd operating-system-users operating-system-groups @@ -109,7 +109,7 @@ boot-parameters-kernel boot-parameters-kernel-arguments boot-parameters-initrd - read-boot-parameters + read-boot-parameters-file local-host-aliases %setuid-programs @@ -122,6 +122,12 @@ ;;; ;;; Code: +(define (bootable-kernel-arguments kernel-arguments system root-device) + (cons* (string-append "--root=" root-device) + (string-append "--system=" system) + (string-append "--load=" system "/boot") + kernel-arguments)) + ;; System-wide configuration. ;; TODO: Add per-field docstrings/stexi. (define-record-type* operating-system @@ -182,6 +188,11 @@ (sudoers-file operating-system-sudoers-file ; file-like (default %sudoers-specification))) +(define (operating-system-all-kernel-arguments os system root-device) + (bootable-kernel-arguments (operating-system-kernel-arguments os) + system + root-device)) + ;;; ;;; Services. @@ -735,29 +746,13 @@ populate the \"old entries\" menu." (mlet* %store-monad ((system (operating-system-derivation os)) (root-fs -> (operating-system-root-file-system os)) - (store-fs -> (operating-system-store-file-system os)) - (label -> (kernel->boot-label (operating-system-kernel os))) - (kernel -> (operating-system-kernel-file os)) - (initrd (operating-system-initrd-file os)) (root-device -> (if (eq? 'uuid (file-system-title root-fs)) (uuid->string (file-system-device root-fs)) (file-system-device root-fs))) - (entries -> (list (menu-entry - (label label) - - ;; The device where the kernel and initrd live. - (device (fs->boot-device store-fs)) - (device-mount-point - (file-system-mount-point store-fs)) - - (linux kernel) - (linux-arguments - (cons* (string-append "--root=" root-device) - #~(string-append "--system=" #$system) - #~(string-append "--load=" #$system - "/boot") - (operating-system-kernel-arguments os))) - (initrd initrd))))) + (entries -> (list (operating-system-boot-parameters + os + #$(derivation->output-path system) + root-device)))) (grub-configuration-file (operating-system-bootloader os) entries #:old-entries old-entries))) @@ -769,6 +764,25 @@ device in a ." ((label) (file-system-device fs)) (else #f))) +(define (operating-system-boot-parameters os system root-device) + "Return a record that describes the boot parameters of OS. +SYSTEM is optional. If given, adds kernel arguments for that system to ." + (let* ((initrd (operating-system-initrd-file os)) + (store (operating-system-store-file-system os)) + (label (kernel->boot-label (operating-system-kernel os)))) + (boot-parameters + ;(version 0) + (label label) + (root-device root-device) + (kernel (operating-system-kernel-file os)) + (kernel-arguments + (if system + (operating-system-all-kernel-arguments os system root-device) + (operating-system-kernel-arguments os))) + (initrd initrd) + (store-device (fs->boot-device store)) + (store-mount-point (file-system-mount-point store))))) + (define (operating-system-parameters-file os) "Return a file that describes the boot parameters of OS. The primary use of this file is the reconstruction of GRUB menu entries for old configurations." @@ -791,6 +805,20 @@ this file is the reconstruction of GRUB menu entries for old configurations." (mount-point #$(file-system-mount-point store)))) #:set-load-path? #f))) +;; Better would be instead, if I ever got it to work: +(define (operating-system-boot-parameters-file os system) + "Return a file that describes the boot parameters of OS. The primary use of +this file is the reconstruction of GRUB menu entries for old configurations. +SYSTEM is optional. If given, adds kernel arguments for that system to the returned file." + (mlet %store-monad ((initrd (operating-system-initrd-file os)) + (root -> (operating-system-root-file-system os)) + (store -> (operating-system-store-file-system os)) + (label -> (kernel->boot-label + (operating-system-kernel os)))) + (gexp->file "parameters" + #~(operating-system-boot-parameters os system (file-system-device root)) + #:set-load-path? #f))) + ;;; ;;; Boot parameters @@ -866,4 +894,22 @@ this file is the reconstruction of GRUB menu entries for old configurations." system) #f))) +(define (read-boot-parameters-file sysgen) + "Read boot parameters from SYSGEN's (system or generation) \"parameters\" +file and returns the corresponding object or #f if the +format is unrecognized. +The object has its kernel-arguments extended in order to make it bootable." + (let* ((file (string-append sysgen "/parameters")) + (params (call-with-input-file file read-boot-parameters)) + (root (boot-parameters-root-device params)) + (root-device (if (bytevector? root) + (uuid->string root) + root)) + (kernel-arguments (boot-parameters-kernel-arguments params))) + (if params + (boot-parameters + (inherit params) + (kernel-arguments (bootable-kernel-arguments kernel-arguments sysgen root-device))) + #f))) + ;;; system.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 374d8b663..e372c27b2 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -490,11 +490,9 @@ it is mostly useful when FULL-BOOT? is true." #:full-boot? full-boot? #:disk-image-size disk-image-size))) (define kernel-arguments - #~(list "--root=/dev/vda1" - (string-append "--system=" #$os-drv) - (string-append "--load=" #$os-drv "/boot") + #~(list #$@(if graphic? #~() #~("console=ttyS0")) - #+@(operating-system-kernel-arguments os))) + #+@(operating-system-all-kernel-arguments os os-drv "/dev/vda1"))) (define qemu-exec #~(list (string-append #$qemu "/bin/" #$(qemu-command (%current-system))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 9ffdc15ab..0749fbbd9 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -365,14 +365,17 @@ it atomically, and then run OS's activation script." (define* (profile-boot-parameters #:optional (profile %system-profile) (numbers (generation-numbers profile))) - "Return a list of 'menu-entry' for the generations of PROFILE specified by + "Return a list of 'boot-parameters' for the generations of PROFILE specified by NUMBERS, which is a list of generation numbers." (define (system->boot-parameters system number time) (unless-file-not-found - (let* ((file (string-append system "/parameters")) - (params (call-with-input-file file - read-boot-parameters))) - params))) + (let* ((params (read-boot-parameters-file system)) + (label (boot-parameters-label params))) + (boot-parameters + (inherit params) + (label (string-append label " (#" + (number->string number) ", " + (seconds->string time) ")")))))) (let* ((systems (map (cut generation-file-name profile <>) numbers)) (times (map (lambda (system) @@ -381,45 +384,6 @@ NUMBERS, which is a list of generation numbers." systems))) (filter-map system->boot-parameters systems numbers times))) -(define* (profile-grub-entries #:optional (profile %system-profile) - (numbers (generation-numbers profile))) - "Return a list of 'menu-entry' for the generations of PROFILE specified by -NUMBERS, which is a list of generation numbers." - (define (system->grub-entry system number time) - (unless-file-not-found - (let* ((file (string-append system "/parameters")) - (params (call-with-input-file file - read-boot-parameters)) - (label (boot-parameters-label params)) - (root (boot-parameters-root-device params)) - (root-device (if (bytevector? root) - (uuid->string root) - root)) - (kernel (boot-parameters-kernel params)) - (kernel-arguments (boot-parameters-kernel-arguments params)) - (initrd (boot-parameters-initrd params))) - (menu-entry - (label (string-append label " (#" - (number->string number) ", " - (seconds->string time) ")")) - (device (boot-parameters-store-device params)) - (device-mount-point (boot-parameters-store-mount-point params)) - (linux kernel) - (linux-arguments - (cons* (string-append "--root=" root-device) - (string-append "--system=" system) - (string-append "--load=" system "/boot") - kernel-arguments)) - (initrd initrd))))) - - (let* ((systems (map (cut generation-file-name profile <>) - numbers)) - (times (map (lambda (system) - (unless-file-not-found - (stat:mtime (lstat system)))) - systems))) - (filter-map system->grub-entry systems numbers times))) - ;;; ;;; Roll-back. @@ -447,18 +411,16 @@ generation as its default entry. STORE is an open connection to the store." "Re-install grub for existing system profile generation NUMBER. STORE is an open connection to the store." (let* ((generation (generation-file-name %system-profile number)) - (file (string-append generation "/parameters")) - (params (unless-file-not-found - (call-with-input-file file read-boot-parameters))) + (params (read-boot-parameters-file generation)) (root-device (boot-parameters-root-device params)) ;; We don't currently keep track of past menu entries' details. The ;; default values will allow the system to boot, even if they differ ;; from the actual past values for this generation's entry. (grub-config (grub-configuration (device root-device))) ;; Make the specified system generation the default entry. - (entries (profile-grub-entries %system-profile (list number))) + (entries (profile-boot-parameters %system-profile (list number))) (old-generations (delv number (generation-numbers %system-profile))) - (old-entries (profile-grub-entries %system-profile old-generations)) + (old-entries (profile-boot-parameters %system-profile old-generations)) (grub.cfg (run-with-store store (grub-configuration-file grub-config entries @@ -533,8 +495,7 @@ list of services." "Display a summary of system generation NUMBER in a human-readable format." (unless (zero? number) (let* ((generation (generation-file-name profile number)) - (param-file (string-append generation "/parameters")) - (params (call-with-input-file param-file read-boot-parameters)) + (params (read-boot-parameters-file generation)) (label (boot-parameters-label params)) (root (boot-parameters-root-device params)) (root-device (if (bytevector? root) @@ -643,7 +604,7 @@ output when building a system derivation, such as a disk image." (operating-system-bootcfg os (if (eq? 'init action) '() - (profile-grub-entries))))) + (profile-boot-parameters))))) ;; For 'init' and 'reconfigure', always build GRUB.CFG, even if ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC