diff options
Diffstat (limited to 'gnu/build')
| -rw-r--r-- | gnu/build/activation.scm | 17 | ||||
| -rw-r--r-- | gnu/build/install.scm | 97 | ||||
| -rw-r--r-- | gnu/build/linux-initrd.scm | 30 | ||||
| -rw-r--r-- | gnu/build/vm.scm | 24 |
4 files changed, 108 insertions, 60 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 68ecd6bc71..0e77677de1 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -148,11 +148,15 @@ properties. Return #t on success." `("-G" ,(string-join supplementary-groups ",")) '()) ,@(if comment `("-c" ,comment) '()) - ,@(if (and home create-home?) - (if (file-exists? home) - `("-d" ,home) ; avoid warning from 'useradd' - `("-d" ,home "--create-home")) + ,@(if home `("-d" ,home) '()) + + ;; Home directories of non-system accounts are created by + ;; 'activate-user-home'. + ,@(if (and home create-home? system? + (not (file-exists? home))) + '("--create-home") '()) + ,@(if shell `("-s" ,shell) '()) ,@(if password `("-p" ,password) '()) ,@(if system? '("--system") '()) @@ -229,10 +233,7 @@ numeric gid or #f." #:supplementary-groups supplementary-groups #:comment comment #:home home - - ;; Home directories of non-system accounts are created by - ;; 'activate-user-home'. - #:create-home? (and create-home? system?) + #:create-home? create-home? #:shell shell #:password password) diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 5a5e703872..c9ebe124fe 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -18,7 +18,6 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu build install) - #:use-module (guix store database) #:use-module (guix build utils) #:use-module (guix build store-copy) #:use-module (srfi srfi-26) @@ -27,6 +26,7 @@ evaluate-populate-directive populate-root-file-system register-closure + install-database-and-gc-roots populate-single-profile-directory)) ;;; Commentary: @@ -141,41 +141,53 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM." (try)) (apply throw args))))))) -(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))) - (register-items items - #:prefix prefix - #:deduplicate? deduplicate? - #:reset-timestamps? reset-timestamps? - #:registration-time %epoch - #:schema schema))) +(define %root-profile + "/var/guix/profiles/per-user/root") + +(define* (install-database-and-gc-roots root database profile + #:key (profile-name "guix-profile")) + "Install DATABASE, the store database, under directory ROOT. Create +PROFILE-NAME and have it link to PROFILE, a store item." + (define (scope file) + (string-append root "/" file)) + + (define (mkdir-p* dir) + (mkdir-p (scope dir))) + + (define (symlink* old new) + (symlink old (scope new))) + + (install-file database (scope "/var/guix/db/")) + (chmod (scope "/var/guix/db/db.sqlite") #o644) + (mkdir-p* "/var/guix/profiles") + (mkdir-p* "/var/guix/gcroots") + (symlink* "/var/guix/profiles" "/var/guix/gcroots/profiles") + + ;; Make root's profile, which makes it a GC root. + (mkdir-p* %root-profile) + (symlink* profile + (string-append %root-profile "/" profile-name "-1-link")) + (symlink* (string-append profile-name "-1-link") + (string-append %root-profile "/" profile-name))) (define* (populate-single-profile-directory directory #:key profile closure - deduplicate? - register? schema) + (profile-name "guix-profile") + database) "Populate DIRECTORY with a store containing PROFILE, whose closure is given in the file called CLOSURE (as generated by #:references-graphs.) DIRECTORY is initialized to contain a single profile under /root pointing to PROFILE. -When REGISTER? is true, initialize DIRECTORY/var/guix/db to reflect the -contents of the store; DEDUPLICATE? determines whether to deduplicate files in -the store. + +When DATABASE is true, copy it to DIRECTORY/var/guix/db and create +DIRECTORY/var/guix/gcroots and friends. + +PROFILE-NAME is the name of the profile being created under +/var/guix/profiles, typically either \"guix-profile\" or \"current-guix\". This is used to create the self-contained tarballs with 'guix pack'." (define (scope file) (string-append directory "/" file)) - (define %root-profile - "/var/guix/profiles/per-user/root") - (define (mkdir-p* dir) (mkdir-p (scope dir))) @@ -185,25 +197,20 @@ This is used to create the self-contained tarballs with 'guix pack'." ;; Populate the store. (populate-store (list closure) directory) - (when register? - (register-closure (canonicalize-path directory) closure - #:deduplicate? deduplicate? - #:schema schema) - - (mkdir-p* "/var/guix/profiles") - (mkdir-p* "/var/guix/gcroots") - (symlink* "/var/guix/profiles" - "/var/guix/gcroots/profiles")) - - ;; Make root's profile, which makes it a GC root. - (mkdir-p* %root-profile) - (symlink* profile - (string-append %root-profile "/guix-profile-1-link")) - (symlink* (string-append %root-profile "/guix-profile-1-link") - (string-append %root-profile "/guix-profile")) - - (mkdir-p* "/root") - (symlink* (string-append %root-profile "/guix-profile") - "/root/.guix-profile")) + (when database + (install-database-and-gc-roots directory database profile + #:profile-name profile-name)) + + (match profile-name + ("guix-profile" + (mkdir-p* "/root") + (symlink* (string-append %root-profile "/guix-profile") + "/root/.guix-profile")) + ("current-guix" + (mkdir-p* "/root/.config/guix") + (symlink* (string-append %root-profile "/current-guix") + "/root/.config/guix/current")) + (_ + #t))) ;;; install.scm ends here diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm index c65b5aacfa..3aaa06d3a0 100644 --- a/gnu/build/linux-initrd.scm +++ b/gnu/build/linux-initrd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -72,11 +72,23 @@ COMPRESS? is true, compress it using GZIP. On success, return OUTPUT." #:file->header cpio:file->cpio-header*))) (or (not compress?) - ;; Use '--no-name' so that gzip records neither a file name nor a time - ;; stamp in its output. - (and (zero? (system* gzip "--best" "--no-name" output)) - (rename-file (string-append output ".gz") - output)) + + ;; Gzip insists on adding a '.gz' suffix and does nothing if the input + ;; file already has that suffix. Shuffle files around to placate it. + (let* ((gz-suffix? (string-suffix? ".gz" output)) + (sans-gz (if gz-suffix? + (string-drop-right output 3) + output))) + (when gz-suffix? + (rename-file output sans-gz)) + ;; Use '--no-name' so that gzip records neither a file name nor a time + ;; stamp in its output. + (and (zero? (system* gzip "--best" "--no-name" sans-gz)) + (begin + (unless gz-suffix? + (rename-file (string-append output ".gz") output)) + output))) + output)) (define (cache-compiled-file-name file) @@ -139,6 +151,12 @@ REFERENCES-GRAPHS." (write-cpio-archive output "." #:gzip gzip)) + ;; Make sure directories are writable so we can delete files. + (for-each make-file-writable + (find-files "contents" + (lambda (file stat) + (eq? 'directory (stat:type stat))) + #:directories? #t)) (delete-file-recursively "contents")) ;;; linux-initrd.scm ends here diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index 5579886264..83ad489cc7 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -25,7 +25,7 @@ #:use-module (guix build utils) #:use-module (guix build store-copy) #:use-module (guix build syscalls) - #:use-module ((guix store database) #:select (reset-timestamps)) + #:use-module (guix store database) #:use-module (gnu build linux-boot) #:use-module (gnu build install) #:use-module (gnu system uuid) @@ -191,6 +191,23 @@ the #:references-graphs parameter of 'derivation'." (mkdir output) (copy-recursively "xchg" output))))) +(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))) + (register-items items + #:prefix prefix + #:deduplicate? deduplicate? + #:reset-timestamps? reset-timestamps? + #:registration-time %epoch + #:schema schema))) + ;;; ;;; Partitions. @@ -460,6 +477,11 @@ GRUB configuration and OS-DRV as the stuff in it." "mnt=/tmp/root/mnt" "-path-list" "-" "--" + + ;; XXX: Add padding to avoid I/O errors on i686: + ;; <https://bugs.gnu.org/33639>. + "-padding" "10m" + "-volid" (string-upcase volume-id) (if volume-uuid `("-volume_date" "uuid" |