system: Define <boot-parameters> before first use.
Fixes <http://bugs.gnu.org/26791>. Reported by Mark H Weaver <mhw@netris.org>. * gnu/system.scm (<boot-parameters>, read-boot-parameters) (read-boot-parameters-file): Move before first use of the 'boot-parameters' macro.
This commit is contained in:
Ludovic Courtès
parent
0fd8e6d39f
commit
8e815c5b69
189
gnu/system.scm
189
gnu/system.scm
|
|
@ -199,6 +199,100 @@ directly by the user."
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
;;; Boot parameters
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define-record-type* <boot-parameters>
|
||||||
|
boot-parameters make-boot-parameters boot-parameters?
|
||||||
|
(label boot-parameters-label)
|
||||||
|
;; Because we will use the 'store-device' to create the GRUB search command,
|
||||||
|
;; the 'store-device' has slightly different semantics than 'root-device'.
|
||||||
|
;; The 'store-device' can be a file system uuid, a file system label, or #f,
|
||||||
|
;; but it cannot be a device path such as "/dev/sda3", since GRUB would not
|
||||||
|
;; understand that. The 'root-device', on the other hand, corresponds
|
||||||
|
;; exactly to the device field of the <file-system> object representing the
|
||||||
|
;; OS's root file system, so it might be a device path like "/dev/sda3".
|
||||||
|
(root-device boot-parameters-root-device)
|
||||||
|
(store-device boot-parameters-store-device)
|
||||||
|
(store-mount-point boot-parameters-store-mount-point)
|
||||||
|
(kernel boot-parameters-kernel)
|
||||||
|
(kernel-arguments boot-parameters-kernel-arguments)
|
||||||
|
(initrd boot-parameters-initrd))
|
||||||
|
|
||||||
|
(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)
|
||||||
|
|
||||||
|
;; In the past, we would store the directory name of the kernel instead
|
||||||
|
;; of the absolute file name of its image. Detect that and correct it.
|
||||||
|
(kernel (if (string=? linux (direct-store-path linux))
|
||||||
|
(string-append linux "/"
|
||||||
|
(system-linux-image-file-name))
|
||||||
|
linux))
|
||||||
|
|
||||||
|
(kernel-arguments
|
||||||
|
(match (assq 'kernel-arguments rest)
|
||||||
|
((_ args) args)
|
||||||
|
(#f '()))) ;the old format
|
||||||
|
|
||||||
|
(initrd
|
||||||
|
(match (assq 'initrd rest)
|
||||||
|
(('initrd ('string-append directory file)) ;the old format
|
||||||
|
(string-append directory file))
|
||||||
|
(('initrd (? string? file))
|
||||||
|
file)))
|
||||||
|
|
||||||
|
(store-device
|
||||||
|
(match (assq 'store rest)
|
||||||
|
(('store ('device device) _ ...)
|
||||||
|
device)
|
||||||
|
(_ ;the old format
|
||||||
|
;; Root might be a device path like "/dev/sda1", which is not a
|
||||||
|
;; suitable GRUB device identifier.
|
||||||
|
(if (string-prefix? "/" root)
|
||||||
|
#f
|
||||||
|
root))))
|
||||||
|
|
||||||
|
(store-mount-point
|
||||||
|
(match (assq 'store rest)
|
||||||
|
(('store ('device _) ('mount-point mount-point) _ ...)
|
||||||
|
mount-point)
|
||||||
|
(_ ;the old format
|
||||||
|
"/")))))
|
||||||
|
(x ;unsupported format
|
||||||
|
(warning (G_ "unrecognized boot parameters for '~a'~%")
|
||||||
|
system)
|
||||||
|
#f)))
|
||||||
|
|
||||||
|
(define (read-boot-parameters-file system)
|
||||||
|
"Read boot parameters from SYSTEM's (system or generation) \"parameters\"
|
||||||
|
file and returns the corresponding <boot-parameters> 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 system "/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
|
||||||
|
system
|
||||||
|
root-device)))
|
||||||
|
#f)))
|
||||||
|
|
||||||
|
;;;
|
||||||
;;; Services.
|
;;; Services.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
|
|
@ -813,99 +907,4 @@ being stored into the \"parameters\" file)."
|
||||||
(mount-point #$(boot-parameters-store-mount-point params))))
|
(mount-point #$(boot-parameters-store-mount-point params))))
|
||||||
#:set-load-path? #f)))
|
#:set-load-path? #f)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; Boot parameters
|
|
||||||
;;;
|
|
||||||
|
|
||||||
(define-record-type* <boot-parameters>
|
|
||||||
boot-parameters make-boot-parameters boot-parameters?
|
|
||||||
(label boot-parameters-label)
|
|
||||||
;; Because we will use the 'store-device' to create the GRUB search command,
|
|
||||||
;; the 'store-device' has slightly different semantics than 'root-device'.
|
|
||||||
;; The 'store-device' can be a file system uuid, a file system label, or #f,
|
|
||||||
;; but it cannot be a device path such as "/dev/sda3", since GRUB would not
|
|
||||||
;; understand that. The 'root-device', on the other hand, corresponds
|
|
||||||
;; exactly to the device field of the <file-system> object representing the
|
|
||||||
;; OS's root file system, so it might be a device path like "/dev/sda3".
|
|
||||||
(root-device boot-parameters-root-device)
|
|
||||||
(store-device boot-parameters-store-device)
|
|
||||||
(store-mount-point boot-parameters-store-mount-point)
|
|
||||||
(kernel boot-parameters-kernel)
|
|
||||||
(kernel-arguments boot-parameters-kernel-arguments)
|
|
||||||
(initrd boot-parameters-initrd))
|
|
||||||
|
|
||||||
(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)
|
|
||||||
|
|
||||||
;; In the past, we would store the directory name of the kernel instead
|
|
||||||
;; of the absolute file name of its image. Detect that and correct it.
|
|
||||||
(kernel (if (string=? linux (direct-store-path linux))
|
|
||||||
(string-append linux "/"
|
|
||||||
(system-linux-image-file-name))
|
|
||||||
linux))
|
|
||||||
|
|
||||||
(kernel-arguments
|
|
||||||
(match (assq 'kernel-arguments rest)
|
|
||||||
((_ args) args)
|
|
||||||
(#f '()))) ;the old format
|
|
||||||
|
|
||||||
(initrd
|
|
||||||
(match (assq 'initrd rest)
|
|
||||||
(('initrd ('string-append directory file)) ;the old format
|
|
||||||
(string-append directory file))
|
|
||||||
(('initrd (? string? file))
|
|
||||||
file)))
|
|
||||||
|
|
||||||
(store-device
|
|
||||||
(match (assq 'store rest)
|
|
||||||
(('store ('device device) _ ...)
|
|
||||||
device)
|
|
||||||
(_ ;the old format
|
|
||||||
;; Root might be a device path like "/dev/sda1", which is not a
|
|
||||||
;; suitable GRUB device identifier.
|
|
||||||
(if (string-prefix? "/" root)
|
|
||||||
#f
|
|
||||||
root))))
|
|
||||||
|
|
||||||
(store-mount-point
|
|
||||||
(match (assq 'store rest)
|
|
||||||
(('store ('device _) ('mount-point mount-point) _ ...)
|
|
||||||
mount-point)
|
|
||||||
(_ ;the old format
|
|
||||||
"/")))))
|
|
||||||
(x ;unsupported format
|
|
||||||
(warning (G_ "unrecognized boot parameters for '~a'~%")
|
|
||||||
system)
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
(define (read-boot-parameters-file system)
|
|
||||||
"Read boot parameters from SYSTEM's (system or generation) \"parameters\"
|
|
||||||
file and returns the corresponding <boot-parameters> 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 system "/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
|
|
||||||
system
|
|
||||||
root-device)))
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
;;; system.scm ends here
|
;;; system.scm ends here
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue