Move <boot-parameters> to (gnu system).
* guix/scripts/system.scm (previous-grub-entries) (display-system-generation): Use accessors instead of matching <boot-parameters>. (boot-parameters, boot-parameters?, boot-parameters-label) (boot-parameters-root-device, boot-parameters-kernel) (boot-parameters-kernel-arguments, read-boot-parameters): Move to... * gnu/system.scm: ... here. Export them.
This commit is contained in:
parent
c3e919d7a0
commit
b8300494c0
|
@ -88,6 +88,14 @@
|
||||||
operating-system-locale-directory
|
operating-system-locale-directory
|
||||||
operating-system-boot-script
|
operating-system-boot-script
|
||||||
|
|
||||||
|
boot-parameters
|
||||||
|
boot-parameters?
|
||||||
|
boot-parameters-label
|
||||||
|
boot-parameters-root-device
|
||||||
|
boot-parameters-kernel
|
||||||
|
boot-parameters-kernel-arguments
|
||||||
|
read-boot-parameters
|
||||||
|
|
||||||
local-host-aliases
|
local-host-aliases
|
||||||
%setuid-programs
|
%setuid-programs
|
||||||
%base-packages
|
%base-packages
|
||||||
|
@ -709,4 +717,37 @@ this file is the reconstruction of GRUB menu entries for old configurations."
|
||||||
#$(operating-system-kernel-arguments os))
|
#$(operating-system-kernel-arguments os))
|
||||||
(initrd #$initrd)))))
|
(initrd #$initrd)))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Boot parameters
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define-record-type* <boot-parameters>
|
||||||
|
boot-parameters make-boot-parameters boot-parameters?
|
||||||
|
(label boot-parameters-label)
|
||||||
|
(root-device boot-parameters-root-device)
|
||||||
|
(kernel boot-parameters-kernel)
|
||||||
|
(kernel-arguments boot-parameters-kernel-arguments))
|
||||||
|
|
||||||
|
(define (read-boot-parameters port)
|
||||||
|
"Read boot parameters from PORT and return the corresponding
|
||||||
|
<boot-parameters> object or #f if the format is unrecognized."
|
||||||
|
(match (read port)
|
||||||
|
(('boot-parameters ('version 0)
|
||||||
|
('label label) ('root-device root)
|
||||||
|
('kernel linux)
|
||||||
|
rest ...)
|
||||||
|
(boot-parameters
|
||||||
|
(label label)
|
||||||
|
(root-device root)
|
||||||
|
(kernel linux)
|
||||||
|
(kernel-arguments
|
||||||
|
(match (assq 'kernel-arguments rest)
|
||||||
|
((_ args) args)
|
||||||
|
(#f '()))))) ;the old format
|
||||||
|
(x ;unsupported format
|
||||||
|
(warning (_ "unrecognized boot parameters for '~a'~%")
|
||||||
|
system)
|
||||||
|
#f)))
|
||||||
|
|
||||||
;;; system.scm ends here
|
;;; system.scm ends here
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -189,39 +190,6 @@ the ownership of '~a' may be incorrect!~%")
|
||||||
(mwhen grub?
|
(mwhen grub?
|
||||||
(install-grub* grub.cfg device target)))))
|
(install-grub* grub.cfg device target)))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; Boot parameters
|
|
||||||
;;;
|
|
||||||
|
|
||||||
(define-record-type* <boot-parameters>
|
|
||||||
boot-parameters make-boot-parameters boot-parameters?
|
|
||||||
(label boot-parameters-label)
|
|
||||||
(root-device boot-parameters-root-device)
|
|
||||||
(kernel boot-parameters-kernel)
|
|
||||||
(kernel-arguments boot-parameters-kernel-arguments))
|
|
||||||
|
|
||||||
(define (read-boot-parameters port)
|
|
||||||
"Read boot parameters from PORT and return the corresponding
|
|
||||||
<boot-parameters> object or #f if the format is unrecognized."
|
|
||||||
(match (read port)
|
|
||||||
(('boot-parameters ('version 0)
|
|
||||||
('label label) ('root-device root)
|
|
||||||
('kernel linux)
|
|
||||||
rest ...)
|
|
||||||
(boot-parameters
|
|
||||||
(label label)
|
|
||||||
(root-device root)
|
|
||||||
(kernel linux)
|
|
||||||
(kernel-arguments
|
|
||||||
(match (assq 'kernel-arguments rest)
|
|
||||||
((_ args) args)
|
|
||||||
(#f '()))))) ;the old format
|
|
||||||
(x ;unsupported format
|
|
||||||
(warning (_ "unrecognized boot parameters for '~a'~%")
|
|
||||||
system)
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Reconfiguration.
|
;;; Reconfiguration.
|
||||||
|
@ -285,22 +253,24 @@ it atomically, and then run OS's activation script."
|
||||||
"Return a list of 'menu-entry' for the generations of PROFILE."
|
"Return a list of 'menu-entry' for the generations of PROFILE."
|
||||||
(define (system->grub-entry system number time)
|
(define (system->grub-entry system number time)
|
||||||
(unless-file-not-found
|
(unless-file-not-found
|
||||||
(let ((file (string-append system "/parameters")))
|
(let* ((file (string-append system "/parameters"))
|
||||||
(match (call-with-input-file file read-boot-parameters)
|
(params (call-with-input-file file
|
||||||
(($ <boot-parameters> label root kernel kernel-arguments)
|
read-boot-parameters))
|
||||||
(menu-entry
|
(label (boot-parameters-label params))
|
||||||
(label (string-append label " (#"
|
(root (boot-parameters-root-device params))
|
||||||
(number->string number) ", "
|
(kernel (boot-parameters-kernel params))
|
||||||
(seconds->string time) ")"))
|
(kernel-arguments (boot-parameters-kernel-arguments params)))
|
||||||
(linux kernel)
|
(menu-entry
|
||||||
(linux-arguments
|
(label (string-append label " (#"
|
||||||
(cons* (string-append "--root=" root)
|
(number->string number) ", "
|
||||||
#~(string-append "--system=" #$system)
|
(seconds->string time) ")"))
|
||||||
#~(string-append "--load=" #$system "/boot")
|
(linux kernel)
|
||||||
kernel-arguments))
|
(linux-arguments
|
||||||
(initrd #~(string-append #$system "/initrd"))))
|
(cons* (string-append "--root=" root)
|
||||||
(#f ;invalid format
|
#~(string-append "--system=" #$system)
|
||||||
#f)))))
|
#~(string-append "--load=" #$system "/boot")
|
||||||
|
kernel-arguments))
|
||||||
|
(initrd #~(string-append #$system "/initrd"))))))
|
||||||
|
|
||||||
(let* ((numbers (generation-numbers profile))
|
(let* ((numbers (generation-numbers profile))
|
||||||
(systems (map (cut generation-file-name profile <>)
|
(systems (map (cut generation-file-name profile <>)
|
||||||
|
@ -366,18 +336,17 @@ list of services."
|
||||||
(unless (zero? number)
|
(unless (zero? number)
|
||||||
(let* ((generation (generation-file-name profile number))
|
(let* ((generation (generation-file-name profile number))
|
||||||
(param-file (string-append generation "/parameters"))
|
(param-file (string-append generation "/parameters"))
|
||||||
(params (call-with-input-file param-file read-boot-parameters)))
|
(params (call-with-input-file param-file read-boot-parameters))
|
||||||
|
(label (boot-parameters-label params))
|
||||||
|
(root (boot-parameters-root-device params))
|
||||||
|
(kernel (boot-parameters-kernel params)))
|
||||||
(display-generation profile number)
|
(display-generation profile number)
|
||||||
(format #t (_ " file name: ~a~%") generation)
|
(format #t (_ " file name: ~a~%") generation)
|
||||||
(format #t (_ " canonical file name: ~a~%") (readlink* generation))
|
(format #t (_ " canonical file name: ~a~%") (readlink* generation))
|
||||||
(match params
|
;; TRANSLATORS: Please preserve the two-space indentation.
|
||||||
(($ <boot-parameters> label root kernel)
|
(format #t (_ " label: ~a~%") label)
|
||||||
;; TRANSLATORS: Please preserve the two-space indentation.
|
(format #t (_ " root device: ~a~%") root)
|
||||||
(format #t (_ " label: ~a~%") label)
|
(format #t (_ " kernel: ~a~%") kernel))))
|
||||||
(format #t (_ " root device: ~a~%") root)
|
|
||||||
(format #t (_ " kernel: ~a~%") kernel))
|
|
||||||
(_
|
|
||||||
#f)))))
|
|
||||||
|
|
||||||
(define* (list-generations pattern #:optional (profile %system-profile))
|
(define* (list-generations pattern #:optional (profile %system-profile))
|
||||||
"Display in a human-readable format all the system generations matching
|
"Display in a human-readable format all the system generations matching
|
||||||
|
|
Loading…
Reference in New Issue