gnu/image.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2020, 2022 Mathieu Othacehe <othacehe@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu image)
  20   #:use-module (guix platform)
  21   #:use-module (guix records)
  22   #:use-module (guix diagnostics)
  23   #:use-module (guix i18n)
  24   #:use-module (srfi srfi-1)
  25   #:use-module (srfi srfi-34)
  26   #:use-module (srfi srfi-35)
  27   #:export (partition
  28             partition?
  29             partition-device
  30             partition-size
  31             partition-offset
  32             partition-file-system
  33             partition-file-system-options
  34             partition-label
  35             partition-uuid
  36             partition-flags
  37             partition-initializer
  38
  39             image
  40             image?
  41             image-name
  42             image-format
  43             image-platform
  44             image-size
  45             image-operating-system
  46             image-partition-table-type
  47             image-partitions
  48             image-compression?
  49             image-volatile-root?
  50             image-shared-store?
  51             image-shared-network?
  52             image-substitutable?
  53
  54             image-type
  55             image-type?
  56             image-type-name
  57             image-type-constructor
  58
  59             os->image
  60             os+platform->image))
  61
  62 \f
  63 ;;;
  64 ;;; Sanitizers.
  65 ;;;
  66
  67 ;; Image and partition sizes can be either be a size in bytes or the 'guess
  68 ;; symbol denoting that the size should be estimated by Guix, according to the
  69 ;; image content.
  70 (define-with-syntax-properties (validate-size (value properties))
  71   (unless (and value
  72                (or (eq? value 'guess) (integer? value)))
  73     (raise
  74        (make-compound-condition
  75         (condition
  76          (&error-location
  77           (location (source-properties->location properties))))
  78         (formatted-message
  79          (G_ "size (~a) can only be 'guess or a numeric expression ~%")
  80          value 'field))))
  81   value)
  82
  83 \f
  84 ;;;
  85 ;;; Partition record.
  86 ;;;
  87
  88 ;; The partition offset should be a bytes count as an integer.
  89 (define-with-syntax-properties (validate-partition-offset (value properties))
  90   (unless (and value (integer? value))
  91     (raise
  92        (make-compound-condition
  93         (condition
  94          (&error-location
  95           (location (source-properties->location properties))))
  96         (formatted-message
  97          (G_ "the partition offset (~a) can only be a \
  98 numeric expression ~%") value 'field))))
  99   value)
 100
 101 ;; The supported partition flags.
 102 (define-with-syntax-properties (validate-partition-flags (value properties))
 103   (let ((bad-flags (lset-difference eq? value '(boot esp))))
 104     (unless (and (list? value) (null? bad-flags))
 105       (raise
 106        (make-compound-condition
 107         (condition
 108          (&error-location
 109           (location (source-properties->location properties))))
 110         (formatted-message
 111          (G_ "unsupported partition flag(s): ~a ~%") bad-flags)))))
 112   value)
 113
 114 (define-record-type* <partition> partition make-partition
 115   partition?
 116   (size                 partition-size   ;size in bytes as integer or 'guess
 117                         (default 'guess)
 118                         (sanitize validate-size))
 119   (offset               partition-offset
 120                         (default 0)   ;offset in bytes as integer
 121                         (sanitize validate-partition-offset))
 122   (file-system          partition-file-system
 123                         (default "ext4"))  ;string
 124   (file-system-options  partition-file-system-options
 125                         (default '()))  ;list of strings
 126   (label                partition-label)  ;string
 127   (uuid                 partition-uuid
 128                         (default #false))  ;<uuid>
 129   (flags                partition-flags
 130                         (default '())  ;list of symbols
 131                         (sanitize validate-partition-flags))
 132   (initializer          partition-initializer
 133                         (default #false))) ;gexp | #false
 134
 135 \f
 136 ;;;
 137 ;;; Image record.
 138 ;;;
 139
 140 (define-syntax-rule (define-set-sanitizer name field set)
 141   "Define NAME as a procedure or macro that raises an error if passed a value
 142 that is not in SET, mentioning FIELD in the error message."
 143   (define-with-syntax-properties (name (value properties))
 144     (unless (memq value 'set)
 145       (raise
 146        (make-compound-condition
 147         (condition
 148          (&error-location
 149           (location (source-properties->location properties))))
 150         (formatted-message (G_ "~s: invalid '~a' value") value 'field))))
 151     value))
 152
 153 ;; The supported image formats.
 154 (define-set-sanitizer validate-image-format format
 155   (disk-image compressed-qcow2 docker iso9660 tarball wsl2))
 156
 157 ;; The supported partition table types.
 158 (define-set-sanitizer validate-partition-table-type partition-table-type
 159   (mbr gpt))
 160
 161 (define-record-type* <image>
 162   image make-image
 163   image?
 164   (name               image-name ;symbol
 165                       (default #false))
 166   (format             image-format                ;symbol
 167                       (sanitize validate-image-format))
 168   (platform           image-platform ;<platform>
 169                       (default #false))
 170   (size               image-size  ;size in bytes as integer
 171                       (default 'guess)
 172                       (sanitize validate-size))
 173   (operating-system   image-operating-system)  ;<operating-system>
 174   (partition-table-type image-partition-table-type ; 'mbr or 'gpt
 175                       (default 'mbr)
 176                       (sanitize validate-partition-table-type))
 177   (partitions         image-partitions ;list of <partition>
 178                       (default '()))
 179   (compression?       image-compression? ;boolean
 180                       (default #true))
 181   (volatile-root?     image-volatile-root? ;boolean
 182                       (default #true))
 183   (shared-store?      image-shared-store? ;boolean
 184                       (default #false))
 185   (shared-network?    image-shared-network? ;boolean
 186                       (default #false))
 187   (substitutable?     image-substitutable? ;boolean
 188                       (default #true)))
 189
 190 \f
 191 ;;;
 192 ;;; Image type.
 193 ;;;
 194
 195 ;; The role of this record is to provide a constructor that is able to turn an
 196 ;; <operating-system> record into an <image> record.  Some basic <image-type>
 197 ;; records are defined in the (gnu system image) module.  They are able to
 198 ;; turn an <operating-system> record into an EFI or an ISO 9660 bootable
 199 ;; image, a Docker image or even a QCOW2 image.
 200 ;;
 201 ;; Other <image-type> records are defined in the (gnu system images ...)
 202 ;; modules.  They are dedicated to specific machines such as Novena and Pine64
 203 ;; SoC boards that require specific images.
 204 ;;
 205 ;; All the available <image-type> records are collected by the 'image-modules'
 206 ;; procedure.  This allows the "guix system image" command to turn a given
 207 ;; <operating-system> record into an image, thanks to the specified
 208 ;; <image-type>.  In that case, the <image-type> look up is done using the
 209 ;; name field of the <image-type> record.
 210
 211 (define-record-type* <image-type>
 212   image-type make-image-type
 213   image-type?
 214   (name           image-type-name) ;symbol
 215   (constructor    image-type-constructor)) ;<operating-system> -> <image>
 216
 217 \f
 218 ;;;
 219 ;;; Image creation.
 220 ;;;
 221
 222 (define* (os->image os #:key type)
 223   "Use the image constructor from TYPE, an <image-type> record to turn the
 224 given OS, an <operating-system> record into an image and return it."
 225   (let ((constructor (image-type-constructor type)))
 226     (constructor os)))
 227
 228 (define* (os+platform->image os platform #:key type)
 229   "Use the image constructor from TYPE, an <image-type> record to turn the
 230 given OS, an <operating-system> record into an image targeting PLATFORM, a
 231 <platform> record and return it."
 232   (image
 233    (inherit (os->image os #:type type))
 234    (platform platform)))