Commit | Line | Data |
---|---|---|
239c2266 | 1 | ;;; GNU Guix --- Functional package management for GNU |
a65177a6 | 2 | ;;; Copyright © 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> |
b2817f0f | 3 | ;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net> |
4a979afe | 4 | ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net> |
272c0709 | 5 | ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> |
db08ea40 | 6 | ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il> |
239c2266 LC |
7 | ;;; |
8 | ;;; This file is part of GNU Guix. | |
9 | ;;; | |
10 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
11 | ;;; under the terms of the GNU General Public License as published by | |
12 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
13 | ;;; your option) any later version. | |
14 | ;;; | |
15 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
16 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;;; GNU General Public License for more details. | |
19 | ;;; | |
20 | ;;; You should have received a copy of the GNU General Public License | |
21 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | (define-module (guix scripts pack) | |
24 | #:use-module (guix scripts) | |
25 | #:use-module (guix ui) | |
26 | #:use-module (guix gexp) | |
27 | #:use-module (guix utils) | |
28 | #:use-module (guix store) | |
2637cfd7 | 29 | #:use-module ((guix status) #:select (with-status-verbosity)) |
b9fcf0c8 | 30 | #:use-module ((guix self) #:select (make-config.scm)) |
239c2266 | 31 | #:use-module (guix grafts) |
41dfe40f | 32 | #:autoload (guix inferior) (inferior-package?) |
239c2266 | 33 | #:use-module (guix monads) |
b1edfbc3 | 34 | #:use-module (guix modules) |
239c2266 LC |
35 | #:use-module (guix packages) |
36 | #:use-module (guix profiles) | |
d40ec4a0 | 37 | #:use-module (guix describe) |
239c2266 | 38 | #:use-module (guix derivations) |
47a60325 LC |
39 | #:use-module (guix search-paths) |
40 | #:use-module (guix build-system gnu) | |
239c2266 | 41 | #:use-module (guix scripts build) |
c45477d2 | 42 | #:use-module ((guix self) #:select (make-config.scm)) |
239c2266 | 43 | #:use-module (gnu packages) |
272c0709 | 44 | #:use-module (gnu packages bootstrap) |
003789e8 | 45 | #:use-module ((gnu packages compression) #:hide (zip)) |
272c0709 | 46 | #:use-module (gnu packages guile) |
16e7afb9 | 47 | #:use-module (gnu packages base) |
239c2266 | 48 | #:autoload (gnu packages package-management) (guix) |
ca719424 | 49 | #:autoload (gnu packages gnupg) (guile-gcrypt) |
d6bf931c | 50 | #:autoload (gnu packages guile) (guile2.0-json guile-json) |
239c2266 LC |
51 | #:use-module (srfi srfi-1) |
52 | #:use-module (srfi srfi-9) | |
aad16cc1 | 53 | #:use-module (srfi srfi-26) |
239c2266 LC |
54 | #:use-module (srfi srfi-37) |
55 | #:use-module (ice-9 match) | |
56 | #:export (compressor? | |
57 | lookup-compressor | |
58 | self-contained-tarball | |
f5a2fb1b | 59 | docker-image |
598a6b87 | 60 | squashfs-image |
f5a2fb1b | 61 | |
239c2266 LC |
62 | guix-pack)) |
63 | ||
64 | ;; Type of a compression tool. | |
65 | (define-record-type <compressor> | |
48b44430 | 66 | (compressor name extension command) |
239c2266 | 67 | compressor? |
48b44430 | 68 | (name compressor-name) ;string (e.g., "gzip") |
af735661 | 69 | (extension compressor-extension) ;string (e.g., ".lz") |
48b44430 | 70 | (command compressor-command)) ;gexp (e.g., #~("/gnu/store/…/gzip" "-9n")) |
239c2266 LC |
71 | |
72 | (define %compressors | |
73 | ;; Available compression tools. | |
af735661 | 74 | (list (compressor "gzip" ".gz" |
48b44430 | 75 | #~(#+(file-append gzip "/bin/gzip") "-9n")) |
af735661 | 76 | (compressor "lzip" ".lz" |
48b44430 | 77 | #~(#+(file-append lzip "/bin/lzip") "-9")) |
af735661 | 78 | (compressor "xz" ".xz" |
e9be2c54 | 79 | #~(#+(file-append xz "/bin/xz") "-e")) |
af735661 RW |
80 | (compressor "bzip2" ".bz2" |
81 | #~(#+(file-append bzip2 "/bin/bzip2") "-9")) | |
82 | (compressor "none" "" #f))) | |
239c2266 | 83 | |
272c0709 CM |
84 | ;; This one is only for use in this module, so don't put it in %compressors. |
85 | (define bootstrap-xz | |
86 | (compressor "bootstrap-xz" ".xz" | |
e9be2c54 | 87 | #~(#+(file-append %bootstrap-coreutils&co "/bin/xz") "-e"))) |
272c0709 | 88 | |
239c2266 LC |
89 | (define (lookup-compressor name) |
90 | "Return the compressor object called NAME. Error out if it could not be | |
91 | found." | |
92 | (or (find (match-lambda | |
93 | (($ <compressor> name*) | |
94 | (string=? name* name))) | |
95 | %compressors) | |
69daee23 | 96 | (leave (G_ "~a: compressor not found~%") name))) |
239c2266 | 97 | |
66e9944e LC |
98 | (define not-config? |
99 | ;; Select (guix …) and (gnu …) modules, except (guix config). | |
100 | (match-lambda | |
101 | (('guix 'config) #f) | |
102 | (('guix _ ...) #t) | |
103 | (('gnu _ ...) #t) | |
104 | (_ #f))) | |
105 | ||
ca719424 LC |
106 | (define gcrypt-sqlite3&co |
107 | ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs. | |
108 | (append-map (lambda (package) | |
109 | (cons package | |
910d0121 LC |
110 | (match (package-transitive-propagated-inputs package) |
111 | (((labels packages) ...) | |
112 | packages)))) | |
ca719424 | 113 | (list guile-gcrypt guile-sqlite3))) |
66e9944e | 114 | |
ec4c81fe LC |
115 | (define (store-database items) |
116 | "Return a directory containing a store database where all of ITEMS and their | |
117 | dependencies are registered." | |
118 | (define schema | |
119 | (local-file (search-path %load-path | |
120 | "guix/store/schema.sql"))) | |
121 | ||
122 | ||
123 | (define labels | |
124 | (map (lambda (n) | |
125 | (string-append "closure" (number->string n))) | |
126 | (iota (length items)))) | |
127 | ||
128 | (define build | |
129 | (with-extensions gcrypt-sqlite3&co | |
ec4c81fe LC |
130 | (with-imported-modules (source-module-closure |
131 | '((guix build store-copy) | |
c1ef50ac | 132 | (guix store database))) |
ec4c81fe LC |
133 | #~(begin |
134 | (use-modules (guix store database) | |
135 | (guix build store-copy) | |
136 | (srfi srfi-1)) | |
137 | ||
138 | (define (read-closure closure) | |
139 | (call-with-input-file closure read-reference-graph)) | |
140 | ||
141 | (let ((items (append-map read-closure '#$labels))) | |
142 | (register-items items | |
143 | #:state-directory #$output | |
144 | #:deduplicate? #f | |
145 | #:reset-timestamps? #f | |
146 | #:registration-time %epoch | |
147 | #:schema #$schema)))))) | |
148 | ||
149 | (computed-file "store-database" build | |
150 | #:options `(#:references-graphs ,(zip labels items)))) | |
151 | ||
239c2266 | 152 | (define* (self-contained-tarball name profile |
5461115e | 153 | #:key target |
08f41083 | 154 | (profile-name "guix-profile") |
5461115e | 155 | deduplicate? |
a0f352b3 | 156 | entry-point |
6b63c43e | 157 | (compressor (first %compressors)) |
5895ec8a | 158 | localstatedir? |
850edd77 | 159 | (symlinks '()) |
5ffac538 | 160 | (archiver tar)) |
239c2266 | 161 | "Return a self-contained tarball containing a store initialized with the |
6b63c43e LC |
162 | closure of PROFILE, a derivation. The tarball contains /gnu/store; if |
163 | LOCALSTATEDIR? is true, it also contains /var/guix, including /var/guix/db | |
5895ec8a LC |
164 | with a properly initialized store database. |
165 | ||
166 | SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be | |
167 | added to the pack." | |
ec4c81fe | 168 | (define database |
c45477d2 | 169 | (and localstatedir? |
ec4c81fe LC |
170 | (file-append (store-database (list profile)) |
171 | "/db/db.sqlite"))) | |
c45477d2 | 172 | |
239c2266 | 173 | (define build |
b27ef1d4 LC |
174 | (with-imported-modules (source-module-closure |
175 | `((guix build utils) | |
176 | (guix build union) | |
177 | (gnu build install)) | |
178 | #:select? not-config?) | |
179 | #~(begin | |
180 | (use-modules (guix build utils) | |
181 | ((guix build union) #:select (relative-file-name)) | |
182 | (gnu build install) | |
183 | (srfi srfi-1) | |
184 | (srfi srfi-26) | |
185 | (ice-9 match)) | |
c45477d2 | 186 | |
b27ef1d4 | 187 | (define %root "root") |
c45477d2 | 188 | |
b27ef1d4 LC |
189 | (define symlink->directives |
190 | ;; Return "populate directives" to make the given symlink and its | |
191 | ;; parent directories. | |
192 | (match-lambda | |
193 | ((source '-> target) | |
194 | (let ((target (string-append #$profile "/" target)) | |
195 | (parent (dirname source))) | |
196 | ;; Never add a 'directory' directive for "/" so as to | |
197 | ;; preserve its ownnership when extracting the archive (see | |
198 | ;; below), and also because this would lead to adding the | |
199 | ;; same entries twice in the tarball. | |
200 | `(,@(if (string=? parent "/") | |
201 | '() | |
202 | `((directory ,parent))) | |
203 | (,source | |
204 | -> ,(relative-file-name parent target))))))) | |
c45477d2 | 205 | |
b27ef1d4 LC |
206 | (define directives |
207 | ;; Fully-qualified symlinks. | |
208 | (append-map symlink->directives '#$symlinks)) | |
c45477d2 | 209 | |
b27ef1d4 LC |
210 | ;; The --sort option was added to GNU tar in version 1.28, released |
211 | ;; 2014-07-28. For testing, we use the bootstrap tar, which is | |
212 | ;; older and doesn't support it. | |
213 | (define tar-supports-sort? | |
214 | (zero? (system* (string-append #+archiver "/bin/tar") | |
215 | "cf" "/dev/null" "--files-from=/dev/null" | |
216 | "--sort=name"))) | |
c45477d2 | 217 | |
b27ef1d4 LC |
218 | ;; Add 'tar' to the search path. |
219 | (setenv "PATH" #+(file-append archiver "/bin")) | |
c45477d2 | 220 | |
b27ef1d4 LC |
221 | ;; Note: there is not much to gain here with deduplication and there |
222 | ;; is the overhead of the '.links' directory, so turn it off. | |
223 | ;; Furthermore GNU tar < 1.30 sometimes fails to extract tarballs | |
224 | ;; with hard links: | |
225 | ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>. | |
226 | (populate-single-profile-directory %root | |
227 | #:profile #$profile | |
08f41083 | 228 | #:profile-name #$profile-name |
b27ef1d4 LC |
229 | #:closure "profile" |
230 | #:database #+database) | |
c45477d2 | 231 | |
b27ef1d4 LC |
232 | ;; Create SYMLINKS. |
233 | (for-each (cut evaluate-populate-directive <> %root) | |
234 | directives) | |
c45477d2 | 235 | |
b27ef1d4 LC |
236 | ;; Create the tarball. Use GNU format so there's no file name |
237 | ;; length limitation. | |
238 | (with-directory-excursion %root | |
239 | (exit | |
240 | (zero? (apply system* "tar" | |
241 | #+@(if (compressor-command compressor) | |
242 | #~("-I" | |
243 | (string-join | |
244 | '#+(compressor-command compressor))) | |
245 | #~()) | |
246 | "--format=gnu" | |
c45477d2 | 247 | |
b27ef1d4 LC |
248 | ;; Avoid non-determinism in the archive. Use |
249 | ;; mtime = 1, not zero, because that is what the | |
250 | ;; daemon does for files in the store (see the | |
251 | ;; 'mtimeStore' constant in local-store.cc.) | |
252 | (if tar-supports-sort? "--sort=name" "--mtime=@1") | |
253 | "--mtime=@1" ;for files in /var/guix | |
254 | "--owner=root:0" | |
255 | "--group=root:0" | |
c45477d2 | 256 | |
b27ef1d4 LC |
257 | "--check-links" |
258 | "-cvf" #$output | |
259 | ;; Avoid adding / and /var to the tarball, so | |
260 | ;; that the ownership and permissions of those | |
261 | ;; directories will not be overwritten when | |
262 | ;; extracting the archive. Do not include /root | |
263 | ;; because the root account might have a | |
264 | ;; different home directory. | |
265 | #$@(if localstatedir? | |
266 | '("./var/guix") | |
267 | '()) | |
c45477d2 | 268 | |
b27ef1d4 | 269 | (string-append "." (%store-directory)) |
c45477d2 | 270 | |
b27ef1d4 LC |
271 | (delete-duplicates |
272 | (filter-map (match-lambda | |
273 | (('directory directory) | |
274 | (string-append "." directory)) | |
275 | ((source '-> _) | |
276 | (string-append "." source)) | |
277 | (_ #f)) | |
278 | directives))))))))) | |
239c2266 | 279 | |
a0f352b3 LC |
280 | (when entry-point |
281 | (warning (G_ "entry point not supported in the '~a' format~%") | |
282 | 'tarball)) | |
283 | ||
af735661 | 284 | (gexp->derivation (string-append name ".tar" |
239c2266 LC |
285 | (compressor-extension compressor)) |
286 | build | |
287 | #:references-graphs `(("profile" ,profile)))) | |
288 | ||
dea62932 LC |
289 | (define (singularity-environment-file profile) |
290 | "Return a shell script that defines the environment variables corresponding | |
291 | to the search paths of PROFILE." | |
292 | (define build | |
293 | (with-extensions (list guile-gcrypt) | |
294 | (with-imported-modules `(((guix config) => ,(make-config.scm)) | |
295 | ,@(source-module-closure | |
296 | `((guix profiles) | |
297 | (guix search-paths)) | |
298 | #:select? not-config?)) | |
299 | #~(begin | |
300 | (use-modules (guix profiles) (guix search-paths) | |
301 | (ice-9 match)) | |
302 | ||
303 | (call-with-output-file #$output | |
304 | (lambda (port) | |
305 | (for-each (match-lambda | |
306 | ((spec . value) | |
307 | (format port "~a=~a~%export ~a~%" | |
308 | (search-path-specification-variable spec) | |
309 | value | |
310 | (search-path-specification-variable spec)))) | |
311 | (profile-search-paths #$profile)))))))) | |
312 | ||
313 | (computed-file "singularity-environment.sh" build)) | |
314 | ||
b2817f0f RW |
315 | (define* (squashfs-image name profile |
316 | #:key target | |
08f41083 | 317 | (profile-name "guix-profile") |
b2817f0f | 318 | (compressor (first %compressors)) |
a0f352b3 | 319 | entry-point |
b2817f0f RW |
320 | localstatedir? |
321 | (symlinks '()) | |
322 | (archiver squashfs-tools-next)) | |
323 | "Return a squashfs image containing a store initialized with the closure of | |
324 | PROFILE, a derivation. The image contains a subset of /gnu/store, empty mount | |
325 | points for virtual file systems (like procfs), and optional symlinks. | |
326 | ||
327 | SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be | |
328 | added to the pack." | |
598a6b87 LC |
329 | (define database |
330 | (and localstatedir? | |
331 | (file-append (store-database (list profile)) | |
332 | "/db/db.sqlite"))) | |
333 | ||
dea62932 LC |
334 | (define environment |
335 | (singularity-environment-file profile)) | |
336 | ||
b2817f0f | 337 | (define build |
ec4c81fe LC |
338 | (with-imported-modules (source-module-closure |
339 | '((guix build utils) | |
598a6b87 | 340 | (guix build store-copy) |
427c87d0 | 341 | (guix build union) |
598a6b87 | 342 | (gnu build install)) |
ec4c81fe LC |
343 | #:select? not-config?) |
344 | #~(begin | |
345 | (use-modules (guix build utils) | |
346 | (guix build store-copy) | |
427c87d0 | 347 | ((guix build union) #:select (relative-file-name)) |
598a6b87 | 348 | (gnu build install) |
ec4c81fe LC |
349 | (srfi srfi-1) |
350 | (srfi srfi-26) | |
351 | (ice-9 match)) | |
352 | ||
598a6b87 | 353 | (define database #+database) |
a0f352b3 | 354 | (define entry-point #$entry-point) |
598a6b87 | 355 | |
ec4c81fe LC |
356 | (setenv "PATH" (string-append #$archiver "/bin")) |
357 | ||
358 | ;; We need an empty file in order to have a valid file argument when | |
359 | ;; we reparent the root file system. Read on for why that's | |
360 | ;; necessary. | |
361 | (with-output-to-file ".empty" (lambda () (display ""))) | |
362 | ||
363 | ;; Create the squashfs image in several steps. | |
364 | ;; Add all store items. Unfortunately mksquashfs throws away all | |
365 | ;; ancestor directories and only keeps the basename. We fix this | |
366 | ;; in the following invocations of mksquashfs. | |
367 | (apply invoke "mksquashfs" | |
368 | `(,@(map store-info-item | |
369 | (call-with-input-file "profile" | |
370 | read-reference-graph)) | |
dea62932 | 371 | #$environment |
ec4c81fe LC |
372 | ,#$output |
373 | ||
374 | ;; Do not perform duplicate checking because we | |
375 | ;; don't have any dupes. | |
376 | "-no-duplicates" | |
377 | "-comp" | |
378 | ,#+(compressor-name compressor))) | |
379 | ||
380 | ;; Here we reparent the store items. For each sub-directory of | |
381 | ;; the store prefix we need one invocation of "mksquashfs". | |
382 | (for-each (lambda (dir) | |
383 | (apply invoke "mksquashfs" | |
384 | `(".empty" | |
385 | ,#$output | |
386 | "-root-becomes" ,dir))) | |
387 | (reverse (string-tokenize (%store-directory) | |
388 | (char-set-complement (char-set #\/))))) | |
389 | ||
390 | ;; Add symlinks and mount points. | |
391 | (apply invoke "mksquashfs" | |
392 | `(".empty" | |
393 | ,#$output | |
394 | ;; Create SYMLINKS via pseudo file definitions. | |
395 | ,@(append-map | |
396 | (match-lambda | |
397 | ((source '-> target) | |
427c87d0 LC |
398 | ;; Create relative symlinks to work around a bug in |
399 | ;; Singularity 2.x: | |
400 | ;; https://bugs.gnu.org/34913 | |
401 | ;; https://github.com/sylabs/singularity/issues/1487 | |
402 | (let ((target (string-append #$profile "/" target))) | |
403 | (list "-p" | |
404 | (string-join | |
405 | ;; name s mode uid gid symlink | |
406 | (list source | |
407 | "s" "777" "0" "0" | |
408 | (relative-file-name (dirname source) | |
409 | target))))))) | |
ec4c81fe LC |
410 | '#$symlinks) |
411 | ||
dea62932 LC |
412 | "-p" "/.singularity.d d 555 0 0" |
413 | ||
414 | ;; Create the environment file. | |
415 | "-p" "/.singularity.d/env d 555 0 0" | |
416 | "-p" ,(string-append | |
417 | "/.singularity.d/env/90-environment.sh s 777 0 0 " | |
418 | (relative-file-name "/.singularity.d/env" | |
419 | #$environment)) | |
420 | ||
a0f352b3 LC |
421 | ;; Create /.singularity.d/actions, and optionally the 'run' |
422 | ;; script, used by 'singularity run'. | |
a0f352b3 | 423 | "-p" "/.singularity.d/actions d 555 0 0" |
dea62932 | 424 | |
a0f352b3 LC |
425 | ,@(if entry-point |
426 | `(;; This one if for Singularity 2.x. | |
427 | "-p" | |
428 | ,(string-append | |
429 | "/.singularity.d/actions/run s 777 0 0 " | |
430 | (relative-file-name "/.singularity.d/actions" | |
431 | (string-append #$profile "/" | |
432 | entry-point))) | |
433 | ||
434 | ;; This one is for Singularity 3.x. | |
435 | "-p" | |
436 | ,(string-append | |
437 | "/.singularity.d/runscript s 777 0 0 " | |
438 | (relative-file-name "/.singularity.d" | |
439 | (string-append #$profile "/" | |
440 | entry-point)))) | |
441 | '()) | |
442 | ||
ec4c81fe LC |
443 | ;; Create empty mount points. |
444 | "-p" "/proc d 555 0 0" | |
445 | "-p" "/sys d 555 0 0" | |
6c5e618c LC |
446 | "-p" "/dev d 555 0 0" |
447 | "-p" "/home d 555 0 0")) | |
598a6b87 LC |
448 | |
449 | (when database | |
450 | ;; Initialize /var/guix. | |
451 | (install-database-and-gc-roots "var-etc" database #$profile) | |
452 | (invoke "mksquashfs" "var-etc" #$output))))) | |
b2817f0f RW |
453 | |
454 | (gexp->derivation (string-append name | |
455 | (compressor-extension compressor) | |
456 | ".squashfs") | |
457 | build | |
458 | #:references-graphs `(("profile" ,profile)))) | |
459 | ||
b1edfbc3 | 460 | (define* (docker-image name profile |
5461115e | 461 | #:key target |
08f41083 | 462 | (profile-name "guix-profile") |
b1edfbc3 | 463 | (compressor (first %compressors)) |
a0f352b3 | 464 | entry-point |
b1edfbc3 LC |
465 | localstatedir? |
466 | (symlinks '()) | |
5ffac538 | 467 | (archiver tar)) |
b1edfbc3 LC |
468 | "Return a derivation to construct a Docker image of PROFILE. The |
469 | image is a tarball conforming to the Docker Image Specification, compressed | |
5461115e LC |
470 | with COMPRESSOR. It can be passed to 'docker load'. If TARGET is true, it |
471 | must a be a GNU triplet and it is used to derive the architecture metadata in | |
472 | the image." | |
f5a2fb1b LC |
473 | (define database |
474 | (and localstatedir? | |
475 | (file-append (store-database (list profile)) | |
476 | "/db/db.sqlite"))) | |
477 | ||
47a60325 LC |
478 | (define defmod 'define-module) ;trick Geiser |
479 | ||
b1edfbc3 | 480 | (define build |
ca719424 LC |
481 | ;; Guile-JSON and Guile-Gcrypt are required by (guix docker). |
482 | (with-extensions (list guile-json guile-gcrypt) | |
b9fcf0c8 LC |
483 | (with-imported-modules `(((guix config) => ,(make-config.scm)) |
484 | ,@(source-module-closure | |
485 | `((guix docker) | |
486 | (guix build store-copy) | |
487 | (guix profiles) | |
488 | (guix search-paths)) | |
489 | #:select? not-config?)) | |
13993c77 | 490 | #~(begin |
b9fcf0c8 LC |
491 | (use-modules (guix docker) (guix build store-copy) |
492 | (guix profiles) (guix search-paths) | |
493 | (srfi srfi-19) (ice-9 match)) | |
494 | ||
495 | (define environment | |
496 | (map (match-lambda | |
497 | ((spec . value) | |
498 | (cons (search-path-specification-variable spec) | |
499 | value))) | |
500 | (profile-search-paths #$profile))) | |
13993c77 LC |
501 | |
502 | (setenv "PATH" (string-append #$archiver "/bin")) | |
503 | ||
504 | (build-docker-image #$output | |
6892f0a2 LC |
505 | (map store-info-item |
506 | (call-with-input-file "profile" | |
507 | read-reference-graph)) | |
13993c77 | 508 | #$profile |
f5a2fb1b | 509 | #:database #+database |
13993c77 | 510 | #:system (or #$target (utsname:machine (uname))) |
b9fcf0c8 | 511 | #:environment environment |
c5f66d29 LC |
512 | #:entry-point #$(and entry-point |
513 | #~(string-append #$profile "/" | |
514 | #$entry-point)) | |
13993c77 LC |
515 | #:symlinks '#$symlinks |
516 | #:compressor '#$(compressor-command compressor) | |
517 | #:creation-time (make-time time-utc 0 1)))))) | |
b1edfbc3 | 518 | |
af735661 | 519 | (gexp->derivation (string-append name ".tar" |
b1edfbc3 LC |
520 | (compressor-extension compressor)) |
521 | build | |
522 | #:references-graphs `(("profile" ,profile)))) | |
239c2266 LC |
523 | |
524 | \f | |
47a60325 LC |
525 | ;;; |
526 | ;;; Compiling C programs. | |
527 | ;;; | |
528 | ||
529 | ;; A C compiler. That lowers to a single program that can be passed typical C | |
530 | ;; compiler flags, and it makes sure the whole toolchain is available. | |
531 | (define-record-type <c-compiler> | |
532 | (%c-compiler toolchain guile) | |
533 | c-compiler? | |
534 | (toolchain c-compiler-toolchain) | |
535 | (guile c-compiler-guile)) | |
536 | ||
537 | (define* (c-compiler #:optional inputs | |
538 | #:key (guile (default-guile))) | |
539 | (%c-compiler inputs guile)) | |
540 | ||
541 | (define (bootstrap-c-compiler) | |
542 | "Return the C compiler that uses the bootstrap toolchain. This is used only | |
543 | by '--bootstrap', for testing purposes." | |
544 | (define bootstrap-toolchain | |
545 | (list (first (assoc-ref %bootstrap-inputs "gcc")) | |
546 | (first (assoc-ref %bootstrap-inputs "binutils")) | |
547 | (first (assoc-ref %bootstrap-inputs "libc")))) | |
548 | ||
549 | (c-compiler bootstrap-toolchain | |
550 | #:guile %bootstrap-guile)) | |
551 | ||
552 | (define-gexp-compiler (c-compiler-compiler (compiler <c-compiler>) system target) | |
553 | "Lower COMPILER to a single script that does the right thing." | |
554 | (define toolchain | |
555 | (or (c-compiler-toolchain compiler) | |
556 | (list (first (assoc-ref (standard-packages) "gcc")) | |
557 | (first (assoc-ref (standard-packages) "ld-wrapper")) | |
558 | (first (assoc-ref (standard-packages) "binutils")) | |
559 | (first (assoc-ref (standard-packages) "libc")) | |
560 | (gexp-input (first (assoc-ref (standard-packages) "libc")) | |
561 | "static")))) | |
562 | ||
563 | (define inputs | |
564 | (match (append-map package-propagated-inputs | |
565 | (filter package? toolchain)) | |
566 | (((labels things . _) ...) | |
567 | (append toolchain things)))) | |
568 | ||
569 | (define search-paths | |
570 | (cons $PATH | |
571 | (append-map package-native-search-paths | |
572 | (filter package? inputs)))) | |
573 | ||
574 | (define run | |
575 | (with-imported-modules (source-module-closure | |
576 | '((guix build utils) | |
577 | (guix search-paths))) | |
578 | #~(begin | |
579 | (use-modules (guix build utils) (guix search-paths) | |
580 | (ice-9 match)) | |
581 | ||
582 | (define (output-file args) | |
583 | (let loop ((args args)) | |
584 | (match args | |
585 | (() "a.out") | |
586 | (("-o" file _ ...) file) | |
587 | ((head rest ...) (loop rest))))) | |
588 | ||
589 | (set-search-paths (map sexp->search-path-specification | |
590 | '#$(map search-path-specification->sexp | |
591 | search-paths)) | |
592 | '#$inputs) | |
593 | ||
594 | (let ((output (output-file (command-line)))) | |
595 | (apply invoke "gcc" (cdr (command-line))) | |
596 | (invoke "strip" output))))) | |
597 | ||
598 | (when target | |
599 | ;; TODO: Yep, we'll have to do it someday! | |
600 | (leave (G_ "cross-compilation not implemented here; | |
601 | please email '~a'~%") | |
602 | (@ (guix config) %guix-bug-report-address))) | |
603 | ||
604 | (gexp->script "c-compiler" run | |
605 | #:guile (c-compiler-guile compiler))) | |
606 | ||
607 | \f | |
608 | ;;; | |
609 | ;;; Wrapped package. | |
610 | ;;; | |
611 | ||
612 | (define* (wrapped-package package | |
99aec37a LC |
613 | #:optional (compiler (c-compiler)) |
614 | #:key proot?) | |
47a60325 LC |
615 | (define runner |
616 | (local-file (search-auxiliary-file "run-in-namespace.c"))) | |
617 | ||
99aec37a LC |
618 | (define (proot) |
619 | (specification->package "proot-static")) | |
620 | ||
47a60325 | 621 | (define build |
91e58855 LC |
622 | (with-imported-modules (source-module-closure |
623 | '((guix build utils) | |
624 | (guix build union))) | |
47a60325 LC |
625 | #~(begin |
626 | (use-modules (guix build utils) | |
91e58855 LC |
627 | ((guix build union) #:select (relative-file-name)) |
628 | (ice-9 ftw) | |
47a60325 LC |
629 | (ice-9 match)) |
630 | ||
631 | (define (strip-store-prefix file) | |
632 | ;; Given a file name like "/gnu/store/…-foo-1.2/bin/foo", return | |
633 | ;; "/bin/foo". | |
634 | (let* ((len (string-length (%store-directory))) | |
635 | (base (string-drop file (+ 1 len)))) | |
636 | (match (string-index base #\/) | |
637 | (#f base) | |
638 | (index (string-drop base index))))) | |
639 | ||
640 | (define (build-wrapper program) | |
641 | ;; Build a user-namespace wrapper for PROGRAM. | |
642 | (format #t "building wrapper for '~a'...~%" program) | |
643 | (copy-file #$runner "run.c") | |
644 | ||
645 | (substitute* "run.c" | |
646 | (("@WRAPPED_PROGRAM@") program) | |
647 | (("@STORE_DIRECTORY@") (%store-directory))) | |
648 | ||
649 | (let* ((base (strip-store-prefix program)) | |
99aec37a LC |
650 | (result (string-append #$output "/" base)) |
651 | (proot #$(and proot? | |
652 | #~(string-drop | |
653 | #$(file-append (proot) "/bin/proot") | |
654 | (+ (string-length (%store-directory)) | |
655 | 1))))) | |
47a60325 | 656 | (mkdir-p (dirname result)) |
99aec37a LC |
657 | (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall" |
658 | "run.c" "-o" result | |
659 | (if proot | |
660 | (list (string-append "-DPROOT_PROGRAM=\"" | |
661 | proot "\"")) | |
662 | '())) | |
47a60325 LC |
663 | (delete-file "run.c"))) |
664 | ||
a65177a6 | 665 | (setvbuf (current-output-port) 'line) |
91e58855 LC |
666 | |
667 | ;; Link the top-level files of PACKAGE so that search paths are | |
668 | ;; properly defined in PROFILE/etc/profile. | |
669 | (mkdir #$output) | |
670 | (for-each (lambda (file) | |
671 | (unless (member file '("." ".." "bin" "sbin" "libexec")) | |
672 | (let ((file* (string-append #$package "/" file))) | |
673 | (symlink (relative-file-name #$output file*) | |
674 | (string-append #$output "/" file))))) | |
675 | (scandir #$package)) | |
676 | ||
47a60325 LC |
677 | (for-each build-wrapper |
678 | (append (find-files #$(file-append package "/bin")) | |
679 | (find-files #$(file-append package "/sbin")) | |
680 | (find-files #$(file-append package "/libexec"))))))) | |
681 | ||
41dfe40f S |
682 | (computed-file (string-append |
683 | (cond ((package? package) | |
684 | (package-full-name package "-")) | |
685 | ((inferior-package? package) | |
686 | (string-append (inferior-package-name package) | |
687 | "-" | |
688 | (inferior-package-version package))) | |
689 | (else "wrapper")) | |
690 | "R") | |
47a60325 LC |
691 | build)) |
692 | ||
693 | (define (map-manifest-entries proc manifest) | |
694 | "Apply PROC to all the entries of MANIFEST and return a new manifest." | |
695 | (make-manifest | |
696 | (map (lambda (entry) | |
697 | (manifest-entry | |
698 | (inherit entry) | |
699 | (item (proc (manifest-entry-item entry))))) | |
700 | (manifest-entries manifest)))) | |
701 | ||
702 | \f | |
239c2266 LC |
703 | ;;; |
704 | ;;; Command-line options. | |
705 | ;;; | |
706 | ||
707 | (define %default-options | |
708 | ;; Alist of default option values. | |
b1edfbc3 | 709 | `((format . tarball) |
08f41083 | 710 | (profile-name . "guix-profile") |
b1edfbc3 | 711 | (system . ,(%current-system)) |
239c2266 | 712 | (substitutes? . #t) |
7920e187 | 713 | (build-hook? . #t) |
239c2266 | 714 | (graft? . #t) |
dc0f74e5 LC |
715 | (print-build-trace? . #t) |
716 | (print-extended-build-trace? . #t) | |
f9a8fce1 | 717 | (multiplexed-build-output? . #t) |
f1de676e | 718 | (debug . 0) |
985730c1 | 719 | (verbosity . 1) |
5895ec8a | 720 | (symlinks . ()) |
239c2266 LC |
721 | (compressor . ,(first %compressors)))) |
722 | ||
b1edfbc3 LC |
723 | (define %formats |
724 | ;; Supported pack formats. | |
725 | `((tarball . ,self-contained-tarball) | |
b2817f0f | 726 | (squashfs . ,squashfs-image) |
b1edfbc3 LC |
727 | (docker . ,docker-image))) |
728 | ||
db08ea40 EF |
729 | (define (show-formats) |
730 | ;; Print the supported pack formats. | |
731 | (display (G_ "The supported formats for 'guix pack' are:")) | |
732 | (newline) | |
733 | (display (G_ " | |
734 | tarball Self-contained tarball, ready to run on another machine")) | |
735 | (display (G_ " | |
736 | squashfs Squashfs image suitable for Singularity")) | |
737 | (display (G_ " | |
738 | docker Tarball ready for 'docker load'")) | |
739 | (newline)) | |
740 | ||
239c2266 LC |
741 | (define %options |
742 | ;; Specifications of the command-line options. | |
743 | (cons* (option '(#\h "help") #f #f | |
744 | (lambda args | |
745 | (show-help) | |
746 | (exit 0))) | |
747 | (option '(#\V "version") #f #f | |
748 | (lambda args | |
749 | (show-version-and-exit "guix pack"))) | |
750 | ||
751 | (option '(#\n "dry-run") #f #f | |
752 | (lambda (opt name arg result) | |
753 | (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) | |
b1edfbc3 LC |
754 | (option '(#\f "format") #t #f |
755 | (lambda (opt name arg result) | |
756 | (alist-cons 'format (string->symbol arg) result))) | |
db08ea40 EF |
757 | (option '("list-formats") #f #f |
758 | (lambda args | |
759 | (show-formats) | |
760 | (exit 0))) | |
47a60325 LC |
761 | (option '(#\R "relocatable") #f #f |
762 | (lambda (opt name arg result) | |
99aec37a LC |
763 | (match (assq-ref result 'relocatable?) |
764 | (#f | |
765 | (alist-cons 'relocatable? #t result)) | |
766 | (_ | |
767 | (alist-cons 'relocatable? 'proot | |
768 | (alist-delete 'relocatable? result)))))) | |
83cfa024 LC |
769 | (option '(#\e "expression") #t #f |
770 | (lambda (opt name arg result) | |
771 | (alist-cons 'expression arg result))) | |
4a979afe KH |
772 | (option '(#\m "manifest") #t #f |
773 | (lambda (opt name arg result) | |
774 | (alist-cons 'manifest arg result))) | |
239c2266 LC |
775 | (option '(#\s "system") #t #f |
776 | (lambda (opt name arg result) | |
777 | (alist-cons 'system arg | |
778 | (alist-delete 'system result eq?)))) | |
a0f352b3 LC |
779 | (option '("entry-point") #t #f |
780 | (lambda (opt name arg result) | |
781 | (alist-cons 'entry-point arg result))) | |
5461115e LC |
782 | (option '("target") #t #f |
783 | (lambda (opt name arg result) | |
784 | (alist-cons 'target arg | |
785 | (alist-delete 'target result eq?)))) | |
239c2266 LC |
786 | (option '(#\C "compression") #t #f |
787 | (lambda (opt name arg result) | |
788 | (alist-cons 'compressor (lookup-compressor arg) | |
789 | result))) | |
5895ec8a LC |
790 | (option '(#\S "symlink") #t #f |
791 | (lambda (opt name arg result) | |
db3f2b61 LC |
792 | ;; Note: Using 'string-split' allows us to handle empty |
793 | ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is | |
794 | ;; a symlink to the profile) correctly. | |
795 | (match (string-split arg (char-set #\=)) | |
5895ec8a LC |
796 | ((source target) |
797 | (let ((symlinks (assoc-ref result 'symlinks))) | |
798 | (alist-cons 'symlinks | |
799 | `((,source -> ,target) ,@symlinks) | |
800 | (alist-delete 'symlinks result eq?)))) | |
801 | (x | |
69daee23 | 802 | (leave (G_ "~a: invalid symlink specification~%") |
5895ec8a | 803 | arg))))) |
d40ec4a0 LC |
804 | (option '("save-provenance") #f #f |
805 | (lambda (opt name arg result) | |
806 | (alist-cons 'save-provenance? #t result))) | |
6b63c43e LC |
807 | (option '("localstatedir") #f #f |
808 | (lambda (opt name arg result) | |
809 | (alist-cons 'localstatedir? #t result))) | |
08f41083 LC |
810 | (option '("profile-name") #t #f |
811 | (lambda (opt name arg result) | |
812 | (match arg | |
813 | ((or "guix-profile" "current-guix") | |
814 | (alist-cons 'profile-name arg result)) | |
815 | (_ | |
816 | (leave (G_ "~a: unsupported profile name~%") arg))))) | |
fd214f15 LC |
817 | (option '(#\r "root") #t #f |
818 | (lambda (opt name arg result) | |
819 | (alist-cons 'gc-root arg result))) | |
820 | ||
f1de676e LC |
821 | (option '(#\v "verbosity") #t #f |
822 | (lambda (opt name arg result) | |
823 | (let ((level (string->number* arg))) | |
824 | (alist-cons 'verbosity level | |
825 | (alist-delete 'verbosity result))))) | |
272c0709 CM |
826 | (option '("bootstrap") #f #f |
827 | (lambda (opt name arg result) | |
828 | (alist-cons 'bootstrap? #t result))) | |
239c2266 LC |
829 | |
830 | (append %transformation-options | |
831 | %standard-build-options))) | |
832 | ||
833 | (define (show-help) | |
69daee23 | 834 | (display (G_ "Usage: guix pack [OPTION]... PACKAGE... |
239c2266 LC |
835 | Create a bundle of PACKAGE.\n")) |
836 | (show-build-options-help) | |
837 | (newline) | |
838 | (show-transformation-options-help) | |
839 | (newline) | |
69daee23 | 840 | (display (G_ " |
b1edfbc3 | 841 | -f, --format=FORMAT build a pack in the given FORMAT")) |
db08ea40 EF |
842 | (display (G_ " |
843 | --list-formats list the formats available")) | |
69daee23 | 844 | (display (G_ " |
47a60325 LC |
845 | -R, --relocatable produce relocatable executables")) |
846 | (display (G_ " | |
83cfa024 | 847 | -e, --expression=EXPR consider the package EXPR evaluates to")) |
69daee23 | 848 | (display (G_ " |
239c2266 | 849 | -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) |
69daee23 | 850 | (display (G_ " |
5461115e | 851 | --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) |
69daee23 | 852 | (display (G_ " |
239c2266 | 853 | -C, --compression=TOOL compress using TOOL--e.g., \"lzip\"")) |
69daee23 | 854 | (display (G_ " |
5895ec8a | 855 | -S, --symlink=SPEC create symlinks to the profile according to SPEC")) |
4a979afe | 856 | (display (G_ " |
485d355c | 857 | -m, --manifest=FILE create a pack with the manifest from FILE")) |
a0f352b3 LC |
858 | (display (G_ " |
859 | --entry-point=PROGRAM | |
860 | use PROGRAM as the entry point of the pack")) | |
d40ec4a0 LC |
861 | (display (G_ " |
862 | --save-provenance save provenance information")) | |
69daee23 | 863 | (display (G_ " |
6b63c43e | 864 | --localstatedir include /var/guix in the resulting pack")) |
08f41083 LC |
865 | (display (G_ " |
866 | --profile-name=NAME | |
867 | populate /var/guix/profiles/.../NAME")) | |
f1de676e | 868 | (display (G_ " |
fd214f15 LC |
869 | -r, --root=FILE make FILE a symlink to the result, and register it |
870 | as a garbage collector root")) | |
871 | (display (G_ " | |
f1de676e | 872 | -v, --verbosity=LEVEL use the given verbosity LEVEL")) |
272c0709 CM |
873 | (display (G_ " |
874 | --bootstrap use the bootstrap binaries to build the pack")) | |
239c2266 | 875 | (newline) |
69daee23 | 876 | (display (G_ " |
239c2266 | 877 | -h, --help display this help and exit")) |
69daee23 | 878 | (display (G_ " |
239c2266 LC |
879 | -V, --version display version information and exit")) |
880 | (newline) | |
881 | (show-bug-report-information)) | |
882 | ||
883 | \f | |
884 | ;;; | |
885 | ;;; Entry point. | |
886 | ;;; | |
887 | ||
888 | (define (guix-pack . args) | |
889 | (define opts | |
890 | (parse-command-line args %options (list %default-options))) | |
891 | ||
83cfa024 LC |
892 | (define maybe-package-argument |
893 | ;; Given an option pair, return a package, a package/output tuple, or #f. | |
894 | (match-lambda | |
895 | (('argument . spec) | |
896 | (call-with-values | |
897 | (lambda () | |
898 | (specification->package+output spec)) | |
899 | list)) | |
900 | (('expression . exp) | |
901 | (read/eval-package-expression exp)) | |
902 | (x #f))) | |
903 | ||
aad16cc1 LC |
904 | (define (manifest-from-args store opts) |
905 | (let* ((transform (options->transformation opts)) | |
906 | (packages (map (match-lambda | |
907 | (((? package? package) output) | |
d26727a1 LC |
908 | (list (transform store package) output)) |
909 | ((? package? package) | |
910 | (list (transform store package) "out"))) | |
aad16cc1 LC |
911 | (filter-map maybe-package-argument opts))) |
912 | (manifest-file (assoc-ref opts 'manifest))) | |
d40ec4a0 LC |
913 | (define properties |
914 | (if (assoc-ref opts 'save-provenance?) | |
915 | (lambda (package) | |
916 | (match (package-provenance package) | |
917 | (#f | |
918 | (warning (G_ "could not determine provenance of package ~a~%") | |
919 | (package-full-name package)) | |
920 | '()) | |
921 | (sexp | |
922 | `((provenance . ,sexp))))) | |
923 | (const '()))) | |
924 | ||
4a979afe KH |
925 | (cond |
926 | ((and manifest-file (not (null? packages))) | |
927 | (leave (G_ "both a manifest and a package list were given~%"))) | |
928 | (manifest-file | |
929 | (let ((user-module (make-user-module '((guix profiles) (gnu))))) | |
930 | (load* manifest-file user-module))) | |
d40ec4a0 LC |
931 | (else |
932 | (manifest | |
933 | (map (match-lambda | |
934 | ((package output) | |
935 | (package->manifest-entry package output | |
936 | #:properties | |
937 | (properties package)))) | |
938 | packages)))))) | |
4a979afe | 939 | |
239c2266 | 940 | (with-error-handling |
aad16cc1 | 941 | (with-store store |
f1de676e | 942 | (with-status-verbosity (assoc-ref opts 'verbosity) |
dc0f74e5 LC |
943 | ;; Set the build options before we do anything else. |
944 | (set-build-options-from-command-line store opts) | |
945 | ||
946 | (parameterize ((%graft? (assoc-ref opts 'graft?)) | |
947 | (%guile-for-build (package-derivation | |
948 | store | |
949 | (if (assoc-ref opts 'bootstrap?) | |
950 | %bootstrap-guile | |
951 | (canonical-package guile-2.2)) | |
952 | (assoc-ref opts 'system) | |
953 | #:graft? (assoc-ref opts 'graft?)))) | |
954 | (let* ((dry-run? (assoc-ref opts 'dry-run?)) | |
955 | (relocatable? (assoc-ref opts 'relocatable?)) | |
99aec37a | 956 | (proot? (eq? relocatable? 'proot)) |
dc0f74e5 LC |
957 | (manifest (let ((manifest (manifest-from-args store opts))) |
958 | ;; Note: We cannot honor '--bootstrap' here because | |
959 | ;; 'glibc-bootstrap' lacks 'libc.a'. | |
960 | (if relocatable? | |
99aec37a LC |
961 | (map-manifest-entries |
962 | (cut wrapped-package <> #:proot? proot?) | |
963 | manifest) | |
dc0f74e5 LC |
964 | manifest))) |
965 | (pack-format (assoc-ref opts 'format)) | |
966 | (name (string-append (symbol->string pack-format) | |
967 | "-pack")) | |
968 | (target (assoc-ref opts 'target)) | |
969 | (bootstrap? (assoc-ref opts 'bootstrap?)) | |
970 | (compressor (if bootstrap? | |
971 | bootstrap-xz | |
972 | (assoc-ref opts 'compressor))) | |
973 | (archiver (if (equal? pack-format 'squashfs) | |
974 | squashfs-tools-next | |
975 | (if bootstrap? | |
976 | %bootstrap-coreutils&co | |
977 | tar))) | |
978 | (symlinks (assoc-ref opts 'symlinks)) | |
979 | (build-image (match (assq-ref %formats pack-format) | |
980 | ((? procedure? proc) proc) | |
981 | (#f | |
982 | (leave (G_ "~a: unknown pack format~%") | |
983 | pack-format)))) | |
08f41083 | 984 | (localstatedir? (assoc-ref opts 'localstatedir?)) |
a0f352b3 | 985 | (entry-point (assoc-ref opts 'entry-point)) |
fd214f15 LC |
986 | (profile-name (assoc-ref opts 'profile-name)) |
987 | (gc-root (assoc-ref opts 'gc-root))) | |
3f832623 LC |
988 | (when (null? (manifest-entries manifest)) |
989 | (warning (G_ "no packages specified; building an empty pack~%"))) | |
990 | ||
dc0f74e5 LC |
991 | (run-with-store store |
992 | (mlet* %store-monad ((profile (profile-derivation | |
993 | manifest | |
427c87d0 LC |
994 | |
995 | ;; Always produce relative | |
996 | ;; symlinks for Singularity (see | |
997 | ;; <https://bugs.gnu.org/34913>). | |
998 | #:relative-symlinks? | |
999 | (or relocatable? | |
1000 | (eq? 'squashfs pack-format)) | |
1001 | ||
dc0f74e5 LC |
1002 | #:hooks (if bootstrap? |
1003 | '() | |
1004 | %default-profile-hooks) | |
1005 | #:locales? (not bootstrap?) | |
1006 | #:target target)) | |
1007 | (drv (build-image name profile | |
1008 | #:target | |
1009 | target | |
1010 | #:compressor | |
1011 | compressor | |
1012 | #:symlinks | |
1013 | symlinks | |
1014 | #:localstatedir? | |
1015 | localstatedir? | |
a0f352b3 LC |
1016 | #:entry-point |
1017 | entry-point | |
08f41083 LC |
1018 | #:profile-name |
1019 | profile-name | |
dc0f74e5 LC |
1020 | #:archiver |
1021 | archiver))) | |
1022 | (mbegin %store-monad | |
1023 | (show-what-to-build* (list drv) | |
1024 | #:use-substitutes? | |
1025 | (assoc-ref opts 'substitutes?) | |
1026 | #:dry-run? dry-run?) | |
1027 | (munless dry-run? | |
1028 | (built-derivations (list drv)) | |
fd214f15 LC |
1029 | (mwhen gc-root |
1030 | (register-root* (match (derivation->output-paths drv) | |
1031 | (((names . items) ...) | |
1032 | items)) | |
1033 | gc-root)) | |
dc0f74e5 LC |
1034 | (return (format #t "~a~%" |
1035 | (derivation->output-path drv)))))) | |
1036 | #:system (assoc-ref opts 'system)))))))) |