diff options
Diffstat (limited to 'gnu/image.scm')
| -rw-r--r-- | gnu/image.scm | 30 |
1 files changed, 27 insertions, 3 deletions
diff --git a/gnu/image.scm b/gnu/image.scm index e10a495d3d..486c02aadc 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -19,6 +19,10 @@ (define-module (gnu image) #:use-module (guix platform) #:use-module (guix records) + #:use-module (guix diagnostics) + #:use-module (guix i18n) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:export (partition partition? partition-device @@ -70,19 +74,38 @@ (label partition-label (default #f)) (uuid partition-uuid (default #f)) (flags partition-flags (default '())) - (initializer partition-initializer (default #f))) + (initializer partition-initializer (default #f))) ;gexp | #f ;;; ;;; Image record. ;;; +(define-syntax-rule (define-set-sanitizer name field set) + "Define NAME as a procedure or macro that raises an error if passed a value +that is not in SET, mentioning FIELD in the error message." + (define-with-syntax-properties (name (value properties)) + (unless (memq value 'set) + (raise + (make-compound-condition + (condition + (&error-location + (location (source-properties->location properties)))) + (formatted-message (G_ "~s: invalid '~a' value") value 'field)))) + value)) + +(define-set-sanitizer validate-image-format format + (disk-image compressed-qcow2 docker iso9660)) +(define-set-sanitizer validate-partition-table-type partition-table-type + (mbr gpt)) + (define-record-type* <image> image make-image image? (name image-name ;symbol (default #f)) - (format image-format) ;symbol + (format image-format ;symbol + (sanitize validate-image-format)) (platform image-platform ;<platform> (default #f)) (size image-size ;size in bytes as integer @@ -90,7 +113,8 @@ (operating-system image-operating-system ;<operating-system> (default #f)) (partition-table-type image-partition-table-type ; 'mbr or 'gpt - (default 'mbr)) + (default 'mbr) + (sanitize validate-partition-table-type)) (partitions image-partitions ;list of <partition> (default '())) (compression? image-compression? ;boolean |