projects/guix·blob ruby-team · refs

238 lines · 8.4 KiB

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