diff options
Diffstat (limited to 'gnu/system.scm')
| -rw-r--r-- | gnu/system.scm | 51 |
1 files changed, 30 insertions, 21 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index c8375680ee..2c81478d00 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -33,6 +33,7 @@ (define-module (gnu system) #:use-module (guix inferior) #:use-module (guix store) + #:use-module (guix memoization) #:use-module (guix monads) #:use-module (guix gexp) #:use-module (guix records) @@ -42,6 +43,7 @@ #:use-module ((guix utils) #:select (substitute-keyword-arguments)) #:use-module (guix i18n) #:use-module (guix diagnostics) + #:use-module (guix ui) #:use-module (gnu packages admin) #:use-module (gnu packages base) #:use-module (gnu packages bash) @@ -78,11 +80,13 @@ #:use-module (gnu system uuid) #:use-module (gnu system file-systems) #:use-module (gnu system mapped-devices) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) #:use-module (rnrs bytevectors) #:export (operating-system operating-system? @@ -296,7 +300,7 @@ VERSION is the target version of the boot-parameters record." (define* (operating-system-kernel-arguments os root-device #:key (version %boot-parameters-version)) "Return all the kernel arguments, including the ones not specified directly -by the user. VERSION should match that of the target <boot-parameter> record +by the user. VERSION should match that of the target <boot-parameters> record object that will contain the kernel parameters." (append (bootable-kernel-arguments os root-device version) (operating-system-user-kernel-arguments os))) @@ -511,6 +515,7 @@ The object has its kernel-arguments extended in order to make it bootable." (boot-parameters-kernel-arguments params)))))) (define (boot-parameters->menu-entry conf) + "Return a <menu-entry> instance given CONF, a <boot-parameters> instance." (let* ((kernel (boot-parameters-kernel conf)) (multiboot-modules (boot-parameters-multiboot-modules conf)) (multiboot? (pair? multiboot-modules))) @@ -600,25 +605,26 @@ from the initrd." (any file-system-needed-for-boot? users))) devices))) -(define (operating-system-bootloader-crypto-devices os) - "Return the subset of mapped devices that the bootloader must open. -Only devices specified by uuid are supported." - (define (valid-crypto-device? dev) - (or (uuid? dev) - (begin - (warning (G_ "\ -mapped-device '~a' may not be mounted by the bootloader.~%") - dev) - #f))) - (filter-map (match-lambda - ((and (= mapped-device-type type) - (= mapped-device-source source)) - (and (eq? luks-device-mapping type) - (valid-crypto-device? source) - source)) - (_ #f)) - ;; XXX: Ordering is important, we trust the returned one. - (operating-system-boot-mapped-devices os))) +(define operating-system-bootloader-crypto-devices + (mlambdaq (os) ;to avoid duplicated output + "Return the sources of the LUKS mapped devices specified by UUID." + ;; XXX: Device ordering is important, we trust the returned one. + (let* ((luks-devices (filter (lambda (m) + (eq? luks-device-mapping + (mapped-device-type m))) + (operating-system-boot-mapped-devices os))) + (uuid-crypto-devices non-uuid-crypto-devices + (partition (compose uuid? mapped-device-source) + luks-devices))) + (when (not (null? non-uuid-crypto-devices)) + (for-each (lambda (dev) + (warning + (source-properties->location (mapped-device-location dev)) + (G_ "mapped device '~a' may be ignored by bootloader~%") + (mapped-device-source dev))) + non-uuid-crypto-devices) + (display-hint "Specify mapped device sources via their LUKS UUID.")) + (map mapped-device-source uuid-crypto-devices)))) (define (device-mapping-services os) "Return the list of device-mapping services for OS as a list." @@ -765,7 +771,10 @@ bookkeeping." %boot-service %hurd-startup-service %activation-service - %shepherd-root-service + (service shepherd-root-service-type + (shepherd-configuration + (shepherd shepherd-0.8))) ;no Fibers + (service user-processes-service-type) (account-service (append (operating-system-accounts os) (operating-system-groups os)) |