aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013-2020, 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr> ;;; ;;; 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 install) #:use-module (guix build syscalls) #:use-module (guix build utils) #:use-module (guix build store-copy) #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:export (install-boot-config evaluate-populate-directive populate-root-file-system install-database-and-gc-roots populate-single-profile-directory mount-cow-store unmount-cow-store)) ;;; Commentary: ;;; ;;; This module supports the installation of the GNU system on a hard disk. ;;; It is meant to be used both in a build environment (in derivations that ;;; build VM images), and on the bare metal (when really installing the ;;; system.) ;;; ;;; Code: (define (install-boot-config bootcfg bootcfg-location mount-point) "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note that the caller must make sure that BOOTCFG is registered as a GC root so that the fonts, background images, etc. referred to by BOOTCFG are not GC'd." (let* ((target (string-append mount-point bootcfg-location)) (pivot (string-append target ".new"))) (mkdir-p (dirname target)) ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't ;; work when /boot is on a separate partition. Do that atomically. (copy-file bootcfg pivot) (rename-file pivot target))) (define* (evaluate-populate-directive directive target #:key (default-gid 0) (default-uid 0) (error-on-dangling-symlink? #t)) "Evaluate DIRECTIVE, an sexp describing a file or directory to create under directory TARGET. DEFAULT-UID and DEFAULT-GID are the default UID and GID in the context of the caller. If the directive matches those defaults then, 'chown' won't be run. When ERROR-ON-DANGLING-SYMLINK? is true, abort with an error when a dangling symlink would be created." (define target* (if (string-suffix? "/" target) target (string-append target "/"))) (let loop ((directive directive)) (catch 'system-error (lambda () (match directive (('directory name) (mkdir-p (string-append target* name))) (('directory name uid gid) (let ((dir (string-append target* name))) (mkdir-p dir) ;; If called from a context without "root" permissions, "chown" ;; to root will fail. In that case, do not try to run "chown" ;; and assume that the file will be chowned elsewhere (when ;; interned in the store for instance). (or (and (= uid default-uid) (= gid default-gid)) (chown dir uid gid)))) (('directory name uid gid mode) (loop `(directory ,nam