mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
7f75a7ec08
The "image-root" derivation output is used as a temporary directory that is passed to mke2fs and mkdosfs later on. By merging the creation of this directory and the production of partition images, we can get rid of the derivation. As mke2fs and mkdosfs are not able to override file permissions, call those commands with fakeroot. This way, all the image files will be owned by root, even if image generation is done in an unprivilegded context. * gnu/system/image.scm (system-disk-image): Merge "image-root" and "iso9660-image" derivations so that we spare an extra derivation. Also add "fakeroot" and its runtime dependencies to the inputs. * gnu/build/image.scm (make-ext-image, make-vfat-image): Make sure that mke2fs and mkdosfs are respectively called by fakeroot.
291 lines
12 KiB
Scheme
291 lines
12 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
|
||
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
|
||
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
|
||
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
|
||
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
|
||
;;;
|
||
;;; This file is part of GNU Guix.
|
||
;;;
|
||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||
;;; under the terms of the GNU General Public License as published by
|
||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||
;;; your option) any later version.
|
||
;;;
|
||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;;; GNU General Public License for more details.
|
||
;;;
|
||
;;; You should have received a copy of the GNU General Public License
|
||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
(define-module (gnu build image)
|
||
#:use-module (guix build store-copy)
|
||
#:use-module (guix build syscalls)
|
||
#:use-module (guix build utils)
|
||
#:use-module (guix store database)
|
||
#:use-module (gnu build bootloader)
|
||
#:use-module (gnu build install)
|
||
#:use-module (gnu build linux-boot)
|
||
#:use-module (gnu image)
|
||
#:use-module (gnu system uuid)
|
||
#:use-module (ice-9 ftw)
|
||
#:use-module (ice-9 match)
|
||
#:use-module (srfi srfi-19)
|
||
#:use-module (srfi srfi-34)
|
||
#:use-module (srfi srfi-35)
|
||
#:export (make-partition-image
|
||
genimage
|
||
initialize-efi-partition
|
||
initialize-root-partition
|
||
|
||
make-iso9660-image))
|
||
|
||
(define (sexp->partition sexp)
|
||
"Take SEXP, a tuple as returned by 'partition->gexp', and turn it into a
|
||
<partition> record."
|
||
(match sexp
|
||
((size file-system file-system-options label uuid)
|
||
(partition (size size)
|
||
(file-system file-system)
|
||
(file-system-options file-system-options)
|
||
(label label)
|
||
(uuid uuid)))))
|
||
|
||
(define (size-in-kib size)
|
||
"Convert SIZE expressed in bytes, to kilobytes and return it as a string."
|
||
(number->string
|
||
(inexact->exact (ceiling (/ size 1024)))))
|
||
|
||
(define (estimate-partition-size root)
|
||
"Given the ROOT directory, evalute and return its size. As this doesn't
|
||
take the partition metadata size into account, take a 25% margin."
|
||
(* 1.25 (file-size root)))
|
||
|
||
(define* (make-ext-image partition target root
|
||
#:key
|
||
(owner-uid 0)
|
||
(owner-gid 0))
|
||
"Handle the creation of EXT2/3/4 partition images. See
|
||
'make-partition-image'."
|
||
(let ((size (partition-size partition))
|
||
(fs (partition-file-system partition))
|
||
(fs-options (partition-file-system-options partition))
|
||
(label (partition-label partition))
|
||
(uuid (partition-uuid partition))
|
||
(journal-options "lazy_itable_init=1,lazy_journal_init=1"))
|
||
(apply invoke
|
||
`("fakeroot" "mke2fs" "-t" ,fs "-d" ,root
|
||
"-L" ,label "-U" ,(uuid->string uuid)
|
||
"-E" ,(format #f "root_owner=~a:~a,~a"
|
||
owner-uid owner-gid journal-options)
|
||
,@fs-options
|
||
,target
|
||
,(format #f "~ak"
|
||
(size-in-kib
|
||
(if (eq? size 'guess)
|
||
(estimate-partition-size root)
|
||
size)))))))
|
||
|
||
(define* (make-vfat-image partition target root)
|
||
"Handle the creation of VFAT partition images. See 'make-partition-image'."
|
||
(let ((size (partition-size partition))
|
||
(label (partition-label partition)))
|
||
(invoke "fakeroot" "mkdosfs" "-n" label "-C" target
|
||
"-F" "16" "-S" "1024"
|
||
(size-in-kib
|
||
(if (eq? size 'guess)
|
||
(estimate-partition-size root)
|
||
size)))
|
||
(for-each (lambda (file)
|
||
(unless (member file '("." ".."))
|
||
(invoke "mcopy" "-bsp" "-i" target
|
||
(string-append root "/" file)
|
||
(string-append "::" file))))
|
||
(scandir root))))
|
||
|
||
(define* (make-partition-image partition-sexp target root)
|
||
"Create and return the image of PARTITION-SEXP as TARGET. Use the given
|
||
ROOT directory to populate the image."
|
||
(let* ((partition (sexp->partition partition-sexp))
|
||
(type (partition-file-system partition)))
|
||
(cond
|
||
((string-prefix? "ext" type)
|
||
(make-ext-image partition target root))
|
||
((string=? type "vfat")
|
||
(make-vfat-image partition target root))
|
||
(else
|
||
(format (current-error-port)
|
||
"Unsupported partition type~%.")))))
|
||
|
||
(define* (genimage config target)
|
||
"Use genimage to generate in TARGET directory, the image described in the
|
||
given CONFIG file."
|
||
;; genimage needs a 'root' directory.
|
||
(mkdir "root")
|
||
(invoke "genimage" "--config" config
|
||
"--outputpath" target))
|
||
|
||
(define* (register-closure prefix closure
|
||
#:key
|
||
(deduplicate? #t) (reset-timestamps? #t)
|
||
(schema (sql-schema)))
|
||
"Register CLOSURE in PREFIX, where PREFIX is the directory name of the
|
||
target store and CLOSURE is the name of a file containing a reference graph as
|
||
produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is
|
||
true, reset timestamps on store files and, if DEDUPLICATE? is true,
|
||
deduplicates files common to CLOSURE and the rest of PREFIX."
|
||
(let ((items (call-with-input-file closure read-reference-graph)))
|
||
(parameterize ((sql-schema schema))
|
||
(with-database (store-database-file #:prefix prefix) db
|
||
(register-items db items
|
||
#:prefix prefix
|
||
#:deduplicate? deduplicate?
|
||
#:reset-timestamps? reset-timestamps?
|
||
#:registration-time %epoch)))))
|
||
|
||
(define* (initialize-efi-partition root
|
||
#:key
|
||
grub-efi
|
||
#:allow-other-keys)
|
||
"Install in ROOT directory, an EFI loader using GRUB-EFI."
|
||
(install-efi-loader grub-efi root))
|
||
|
||
(define* (initialize-root-partition root
|
||
#:key
|
||
bootcfg
|
||
bootcfg-location
|
||
bootloader-package
|
||
bootloader-installer
|
||
(deduplicate? #t)
|
||
references-graphs
|
||
(register-closures? #t)
|
||
system-directory
|
||
make-device-nodes
|
||
#:allow-other-keys)
|
||
"Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to
|
||
install the bootloader configuration.
|
||
|
||
If REGISTER-CLOSURES? is true, register REFERENCES-GRAPHS in the store. If
|
||
DEDUPLICATE? is true, then also deduplicate files common to CLOSURES and the
|
||
rest of the store when registering the closures. SYSTEM-DIRECTORY is the name
|
||
of the directory of the 'system' derivation."
|
||
(populate-root-file-system system-directory root)
|
||
(populate-store references-graphs root)
|
||
|
||
;; Populate /dev.
|
||
(when make-device-nodes
|
||
(make-device-nodes root))
|
||
|
||
(when register-closures?
|
||
(for-each (lambda (closure)
|
||
(register-closure root
|
||
closure
|
||
#:reset-timestamps? #t
|
||
#:deduplicate? deduplicate?))
|
||
references-graphs))
|
||
|
||
(when bootloader-installer
|
||
(display "installing bootloader...\n")
|
||
(bootloader-installer bootloader-package #f root))
|
||
(when bootcfg
|
||
(install-boot-config bootcfg bootcfg-location root)))
|
||
|
||
(define* (make-iso9660-image xorriso grub-mkrescue-environment
|
||
grub bootcfg system-directory root target
|
||
#:key (volume-id "Guix_image") (volume-uuid #f)
|
||
register-closures? (references-graphs '())
|
||
(compression? #t))
|
||
"Given a GRUB package, creates an iso image as TARGET, using BOOTCFG as
|
||
GRUB configuration and OS-DRV as the stuff in it."
|
||
(define grub-mkrescue
|
||
(string-append grub "/bin/grub-mkrescue"))
|
||
|
||
(define grub-mkrescue-sed.sh
|
||
(string-append (getcwd) "/" "grub-mkrescue-sed.sh"))
|
||
|
||
;; Use a modified version of grub-mkrescue-sed.sh, see below.
|
||
(copy-file (string-append xorriso
|
||
"/bin/grub-mkrescue-sed.sh")
|
||
grub-mkrescue-sed.sh)
|
||
|
||
;; Force grub-mkrescue-sed.sh to use the build directory instead of /tmp
|
||
;; that is read-only inside the build container.
|
||
(substitute* grub-mkrescue-sed.sh
|
||
(("/tmp/") (string-append (getcwd) "/"))
|
||
(("MKRESCUE_SED_XORRISO_ARGS \\$x")
|
||
(format #f "MKRESCUE_SED_XORRISO_ARGS $(echo $x | sed \"s|/tmp|~a|\")"
|
||
(getcwd))))
|
||
|
||
;; 'grub-mkrescue' calls out to mtools programs to create 'efi.img', a FAT
|
||
;; file system image, and mtools honors SOURCE_DATE_EPOCH for the mtime of
|
||
;; those files. The epoch for FAT is Jan. 1st 1980, not 1970, so choose
|
||
;; that.
|
||
(setenv "SOURCE_DATE_EPOCH"
|
||
(number->string
|
||
(time-second
|
||
(date->time-utc (make-date 0 0 0 0 1 1 1980 0)))))
|
||
|
||
;; Our patched 'grub-mkrescue' honors this environment variable and passes
|
||
;; it to 'mformat', which makes it the serial number of 'efi.img'. This
|
||
;; allows for deterministic builds.
|
||
(setenv "GRUB_FAT_SERIAL_NUMBER"
|
||
(number->string (if volume-uuid
|
||
|
||
;; On 32-bit systems the 2nd argument must be
|
||
;; lower than 2^32.
|
||
(string-hash (iso9660-uuid->string volume-uuid)
|
||
(- (expt 2 32) 1))
|
||
|
||
#x77777777)
|
||
16))
|
||
|
||
(setenv "MKRESCUE_SED_MODE" "original")
|
||
(setenv "MKRESCUE_SED_XORRISO" (string-append xorriso "/bin/xorriso"))
|
||
(setenv "MKRESCUE_SED_IN_EFI_NO_PT" "yes")
|
||
|
||
(for-each (match-lambda
|
||
((name . value) (setenv name value)))
|
||
grub-mkrescue-environment)
|
||
|
||
(apply invoke grub-mkrescue
|
||
(string-append "--xorriso=" grub-mkrescue-sed.sh)
|
||
"-o" target
|
||
(string-append "boot/grub/grub.cfg=" bootcfg)
|
||
root
|
||
"--"
|
||
;; Set all timestamps to 1.
|
||
"-volume_date" "all_file_dates" "=1"
|
||
|
||
`(,@(if compression?
|
||
'(;; ‘zisofs’ compression reduces the total image size by
|
||
;; ~60%.
|
||
"-zisofs" "level=9:block_size=128k" ; highest compression
|
||
;; It's transparent to our Linux-Libre kernel but not to
|
||
;; GRUB. Don't compress the kernel, initrd, and other
|
||
;; files read by grub.cfg, as well as common
|
||
;; already-compressed file names.
|
||
"-find" "/" "-type" "f"
|
||
;; XXX Even after "--" above, and despite documentation
|
||
;; claiming otherwise, "-or" is stolen by grub-mkrescue
|
||
;; which then chokes on it (as ‘-o …’) and dies. Don't use
|
||
;; "-or".
|
||
"-not" "-wholename" "/boot/*"
|
||
"-not" "-wholename" "/System/*"
|
||
"-not" "-name" "unicode.pf2"
|
||
"-not" "-name" "bzImage"
|
||
"-not" "-name" "*.gz" ; initrd & all man pages
|
||
"-not" "-name" "*.png" ; includes grub-image.png
|
||
"-exec" "set_filter" "--zisofs"
|
||
"--")
|
||
'())
|
||
"-volid" ,(string-upcase volume-id)
|
||
,@(if volume-uuid
|
||
`("-volume_date" "uuid"
|
||
,(string-filter (lambda (value)
|
||
(not (char=? #\- value)))
|
||
(iso9660-uuid->string
|
||
volume-uuid)))
|
||
'()))))
|