ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

system: Introduce a disjoint UUID type.

Browse source 
Conceptually a UUID is just a bytevector.  However, there's software out
there such as GRUB that relies on the string representation of different
UUID types (e.g., the string representation of DCE UUIDs differs from
that of ISO-9660 UUIDs, even if they are actually bytevectors of the
same length).  This new <uuid> record type allows us to preserve
information about the type of UUID so we can eventually convert it to a
string using the right representation.

* gnu/system/uuid.scm (<uuid>): New record type.
(bytevector->uuid): New procedure.
(uuid): Return calls to 'make-uuid'.
(uuid->string): Rewrite using 'match-lambda*' to accept a single 'uuid?'
argument.
* gnu/bootloader/grub.scm (grub-root-search): Check for 'uuid?' instead
of 'bytevector?'.
* gnu/system.scm (bootable-kernel-arguments): Check whether ROOT-DEVICE
is 'uuid?'.
(read-boot-parameters): Use 'bytevector->uuid' when the
store device is a bytevector.
(read-boot-parameters-file): Check for 'uuid?' instead of 'bytevector?'.
(device->sexp): New procedure.
(operating-system-boot-parameters-file): Use it for 'root-device' and
'store'.
(operating-system-bootcfg): Remove conditional in definition of
'root-device'.
* gnu/system/file-systems.scm (file-system->spec): Check for 'uuid?' on
DEVICE and take its bytevector.
* gnu/system/mapped-devices.scm (open-luks-device): Likewise.
* gnu/system/vm.scm (iso9660-image): Call 'uuid-bytevector' for the
 #:volume-uuid argument.
This commit is contained in:
Ludovic Courtès 2017-09-06 09:28:28 +02:00
parent d1ff5f9db3
commit 9b336338cd
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
6 changed files with 82 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
gnu/bootloader/grub.scm
View file

@ -30,7 +30,7 @@ (define-module (gnu bootloader grub)
#:use-module (gnu artwork)
#:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
@ -300,7 +300,7 @@ (define (grub-root-search device file)
(match device
;; Preferably refer to DEVICE by its UUID or label. This is more
;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
((? bytevector? uuid)
((? uuid? uuid)
(format #f "search --fs-uuid --set ~a"
(uuid->string device)))
((? string? label)

38
gnu/system.scm
View file

@ -54,6 +54,7 @@ (define-module (gnu system)
#:use-module (gnu system locale)
#:use-module (gnu system pam)
#:use-module (gnu system linux-initrd)
#:use-module (gnu system uuid)
#:use-module (gnu system file-systems)
#:use-module (gnu system mapped-devices)
#:use-module (ice-9 match)
@ -128,7 +129,14 @@ (define-module (gnu system)
(define (bootable-kernel-arguments kernel-arguments system.drv root-device)
"Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be
booted from ROOT-DEVICE"
(cons* (string-append "--root=" root-device)
(cons* (string-append "--root="
(if (uuid? root-device)
;; Note: Always use the DCE format because that's
;; what (gnu build linux-boot) expects for the
;; '--root' kernel command-line option.
(uuid->string (uuid-bytevector root-device) 'dce)
root-device))
#~(string-append "--system=" #$system.drv)
#~(string-append "--load=" #$system.drv "/boot")
kernel-arguments))
@ -261,6 +269,8 @@ (define (read-boot-parameters port)
(store-device
(match (assq 'store rest)
(('store ('device (? bytevector? bv)) _ ...)
(bytevector->uuid bv))
(('store ('device device) _ ...)
device)
(_ ;the old format
@ -289,16 +299,12 @@ (define (read-boot-parameters-file system)
(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)))
system root)))
#f)))
(define (boot-parameters->menu-entry conf)
@ -875,9 +881,7 @@ (define* (operating-system-bootcfg os #:optional (old-entries '()))
(mlet* %store-monad
((system (operating-system-derivation os))
(root-fs -> (operating-system-root-file-system os))
(root-device -> (if (eq? 'uuid (file-system-title root-fs))
(uuid->string (file-system-device root-fs))
(file-system-device root-fs)))
(root-device -> (file-system-device root-fs))
(params (operating-system-boot-parameters os system root-device))
(entry -> (boot-parameters->menu-entry params))
(bootloader-conf -> (operating-system-bootloader os)))
@ -917,6 +921,15 @@ (define (operating-system-boot-parameters os system.drv root-device)
(store-device (fs->boot-device store))
(store-mount-point (file-system-mount-point store))))))
(define (device->sexp device)
"Serialize DEVICE as an sexp (really, as an object with a read syntax.)"
(match device
((? uuid? uuid)
;; TODO: Preserve the type of UUID.
(uuid-bytevector uuid))
(_
device)))
(define* (operating-system-boot-parameters-file os #:optional (system.drv #f))
"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.
@ -934,14 +947,17 @@ (define* (operating-system-boot-parameters-file os #:optional (system.drv #f))
#~(boot-parameters
(version 0)
(label #$(boot-parameters-label params))
(root-device #$(boot-parameters-root-device params))
(root-device
#$(device->sexp
(boot-parameters-root-device params)))
(kernel #$(boot-parameters-kernel params))
(kernel-arguments
#$(boot-parameters-kernel-arguments params))
(initrd #$(boot-parameters-initrd params))
(bootloader-name #$(boot-parameters-bootloader-name params))
(store
(device #$(boot-parameters-store-device params))
(device
#$(device->sexp (boot-parameters-store-device params)))
(mount-point #$(boot-parameters-store-mount-point params))))
#:set-load-path? #f)))

8
gnu/system/file-systems.scm
View file

@ -20,8 +20,7 @@ (define-module (gnu system file-systems)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (guix records)
#:use-module ((gnu system uuid)
#:select (uuid string->uuid uuid->string))
#:use-module (gnu system uuid)
#:re-export (uuid ;backward compatibility
string->uuid
uuid->string)
@ -157,7 +156,10 @@ (define (file-system->spec fs)
initrd code."
(match fs
(($ <file-system> device title mount-point type flags options _ _ check?)
(list device title mount-point type flags options check?))))
(list (if (uuid? device)
(uuid-bytevector device)
device)
title mount-point type flags options check?))))
(define (spec->file-system sexp)
"Deserialize SEXP, a list, to the corresponding <file-system> object."

7
gnu/system/mapped-devices.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017 Mark H Weaver <mhw@netris.org>
;;;
@ -24,6 +24,7 @@ (define-module (gnu system mapped-devices)
#:use-module (guix modules)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system uuid)
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
#:autoload (gnu packages linux) (mdadm-static)
#:use-module (srfi srfi-1)
@ -99,7 +100,9 @@ (define (open-luks-device source target)
'cryptsetup'."
(with-imported-modules (source-module-closure
'((gnu build file-systems)))
#~(let ((source #$source))
#~(let ((source #$(if (uuid? source)
(uuid-bytevector source)
source)))
;; XXX: 'use-modules' should be at the top level.
(use-modules (rnrs bytevectors) ;bytevector?
((gnu build file-systems)

48
gnu/system/uuid.scm
View file

@ -19,12 +19,19 @@
(define-module (gnu system uuid)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module (ice-9 regex)
#:use-module (ice-9 format)
#:export (uuid
uuid?
uuid-type
uuid-bytevector
bytevector->uuid
uuid->string
dce-uuid->string
string->uuid
@ -206,15 +213,27 @@ (define* (string->uuid str #:key (type 'dce))
(#f #f)
((_ . (? procedure? parse)) (parse str))))
(define* (uuid->string bv #:key (type 'dce))
"Convert BV, a bytevector, to the UUID string representation for TYPE."
(match (vhash-assq type %uuid-printers)
(#f #f)
((_ . (? procedure? unparse)) (unparse bv))))
;; High-level UUID representation that carries its type with it.
;;
;; This is necessary to serialize bytevectors with the right printer in some
;; circumstances. For instance, GRUB "search --fs-uuid" command compares the
;; string representation of UUIDs, not the raw bytes; thus, when emitting a
;; GRUB 'search' command, we need to procedure the right string representation
;; (see <https://debbugs.gnu.org/cgi/bugreport.cgi?msg=52;att=0;bug=27735>).
(define-record-type <uuid>
(make-uuid type bv)
uuid?
(type uuid-type) ;'dce | 'iso9660 | ...
(bv uuid-bytevector))
(define* (bytevector->uuid bv #:optional (type 'dce))
"Return a UUID object make of BV and TYPE."
(make-uuid type bv))
(define-syntax uuid
(lambda (s)
"Return the bytevector corresponding to the given UUID representation."
"Return the UUID object corresponding to the given UUID representation."
;; TODO: Extend to types other than DCE.
(syntax-case s ()
((_ str)
(string? (syntax->datum #'str))
@ -222,6 +241,19 @@ (define-syntax uuid
(let ((bv (string->uuid (syntax->datum #'str))))
(unless bv
(syntax-violation 'uuid "invalid UUID" s))
(datum->syntax #'str bv)))
#`(make-uuid 'dce #,(datum->syntax #'str bv))))
((_ str)
#'(string->uuid str)))))
#'(make-uuid 'dce (string->uuid str))))))
(define uuid->string
;; Convert the given bytevector or UUID object, to the corresponding UUID
;; string representation.
(match-lambda*
(((? bytevector? bv))
(uuid->string bv 'dce))
(((? bytevector? bv) type)
(match (vhash-assq type %uuid-printers)
(#f #f)
((_ . (? procedure? unparse)) (unparse bv))))
(((? uuid? uuid))
(uuid->string (uuid-bytevector uuid) (uuid-type uuid)))))

4
gnu/system/vm.scm
View file

@ -57,6 +57,7 @@ (define-module (gnu system vm)
#:use-module (gnu system file-systems)
#:use-module (gnu system)
#:use-module (gnu services)
#:use-module (gnu system uuid)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@ -231,7 +232,8 @@ (define* (iso9660-image #:key
#:register-closures? #$register-closures?
#:closures graphs
#:volume-id #$file-system-label
#:volume-uuid #$file-system-uuid)
#:volume-uuid #$(and=> file-system-uuid
uuid-bytevector))
(reboot))))
#:system system
#:make-disk-image? #f