diff options
Diffstat (limited to 'gnu/image.scm')
| -rw-r--r-- | gnu/image.scm | 102 |
1 files changed, 91 insertions, 11 deletions
diff --git a/gnu/image.scm b/gnu/image.scm index 486c02aadc..a031e87924 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020 Mathieu Othacehe <[email protected]> +;;; Copyright © 2020, 2022 Mathieu Othacehe <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +21,7 @@ #:use-module (guix records) #:use-module (guix diagnostics) #:use-module (guix i18n) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (partition @@ -60,21 +61,75 @@ ;;; +;;; Sanitizers. +;;; + +;; Image and partition sizes can be either be a size in bytes or the 'guess +;; symbol denoting that the size should be estimated by Guix, according to the +;; image content. +(define-with-syntax-properties (validate-size (value properties)) + (unless (and value + (or (eq? value 'guess) (integer? value))) + (raise + (make-compound-condition + (condition + (&error-location + (location (source-properties->location properties)))) + (formatted-message + (G_ "size (~a) can only be 'guess or a numeric expression ~%") + value 'field)))) + value) + + +;;; ;;; Partition record. ;;; +;; The partition offset should be a bytes count as an integer. +(define-with-syntax-properties (validate-partition-offset (value properties)) + (unless (and value (integer? value)) + (raise + (make-compound-condition + (condition + (&error-location + (location (source-properties->location properties)))) + (formatted-message + (G_ "the partition offset (~a) can only be a \ +numeric expression ~%") value 'field)))) + value) + +;; The supported partition flags. +(define-with-syntax-properties (validate-partition-flags (value properties)) + (let ((bad-flags (lset-difference eq? value '(boot esp)))) + (unless (and (list? value) (null? bad-flags)) + (raise + (make-compound-condition + (condition + (&error-location + (location (source-properties->location properties)))) + (formatted-message + (G_ "unsupported partition flag(s): ~a ~%") bad-flags))))) + value) + (define-record-type* <partition> partition make-partition partition? - (device partition-device (default #f)) - (size partition-size) - (offset partition-offset (default 0)) - (file-system partition-file-system (default "ext4")) + (size partition-size ;size in bytes as integer or 'guess + (sanitize validate-size)) + (offset partition-offset + (default 0) ;offset in bytes as integer + (sanitize validate-partition-offset)) + (file-system partition-file-system + (default "ext4")) ;string (file-system-options partition-file-system-options - (default '())) - (label partition-label (default #f)) - (uuid partition-uuid (default #f)) - (flags partition-flags (default '())) - (initializer partition-initializer (default #f))) ;gexp | #f + (default '())) ;list of strings + (label partition-label) ;string + (uuid partition-uuid + (default #f)) ;<uuid> + (flags partition-flags + (default '()) ;list of symbols + (sanitize validate-partition-flags)) + (initializer partition-initializer + (default #f))) ;gexp | #f ;;; @@ -94,8 +149,11 @@ that is not in SET, mentioning FIELD in the error message." (formatted-message (G_ "~s: invalid '~a' value") value 'field)))) value)) +;; The supported image formats. (define-set-sanitizer validate-image-format format (disk-image compressed-qcow2 docker iso9660)) + +;; The supported partition table types. (define-set-sanitizer validate-partition-table-type partition-table-type (mbr gpt)) @@ -109,7 +167,8 @@ that is not in SET, mentioning FIELD in the error message." (platform image-platform ;<platform> (default #f)) (size image-size ;size in bytes as integer - (default 'guess)) + (default 'guess) + (sanitize validate-size)) (operating-system image-operating-system ;<operating-system> (default #f)) (partition-table-type image-partition-table-type ; 'mbr or 'gpt @@ -133,6 +192,22 @@ that is not in SET, mentioning FIELD in the error message." ;;; Image type. ;;; +;; The role of this record is to provide a constructor that is able to turn an +;; <operating-system> record into an <image> record. Some basic <image-type> +;; records are defined in the (gnu system image) module. They are able to +;; turn an <operating-system> record into an EFI or an ISO 9660 bootable +;; image, a Docker image or even a QCOW2 image. +;; +;; Other <image-type> records are defined in the (gnu system images ...) +;; modules. They are dedicated to specific machines such as Novena and Pine64 +;; SoC boards that require specific images. +;; +;; All the available <image-type> records are collected by the 'image-modules' +;; procedure. This allows the "guix system image" command to turn a given +;; <operating-system> record into an image, thanks to the specified +;; <image-type>. In that case, the <image-type> look up is done using the +;; name field of the <image-type> record. + (define-record-type* <image-type> image-type make-image-type image-type? @@ -145,10 +220,15 @@ that is not in SET, mentioning FIELD in the error message." ;;; (define* (os->image os #:key type) + "Use the image constructor from TYPE, an <image-type> record to turn the +given OS, an <operating-system> record into an image and return it." (let ((constructor (image-type-constructor type))) (constructor os))) (define* (os+platform->image os platform #:key type) + "Use the image constructor from TYPE, an <image-type> record to turn the +given OS, an <operating-system> record into an image targeting PLATFORM, a +<platform> record and return it." (image (inherit (os->image os #:type type)) (platform platform))) |