diff options
Diffstat (limited to 'guix/build/profiles.scm')
| -rw-r--r-- | guix/build/profiles.scm | 149 |
1 files changed, 149 insertions, 0 deletions
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm new file mode 100644 index 0000000000..6e316d5d2c --- /dev/null +++ b/guix/build/profiles.scm @@ -0,0 +1,149 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 (guix build profiles) + #:use-module (guix build union) + #:use-module (guix build utils) + #:use-module (guix search-paths) + #:use-module (srfi srfi-26) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:export (ensure-writable-directory + build-profile)) + +;;; Commentary: +;;; +;;; Build a user profile (essentially the union of all the installed packages) +;;; with its associated meta-data. +;;; +;;; Code: + +(define (abstract-profile profile) + "Return a procedure that replaces PROFILE in VALUE with a reference to the +'GUIX_PROFILE' environment variable. This allows users to specify what the +user-friendly name of the profile is, for instance ~/.guix-profile rather than +/gnu/store/...-profile." + (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}"))) + (match-lambda + ((search-path . value) + (let* ((separator (search-path-specification-separator search-path)) + (items (string-tokenize* value separator)) + (crop (cute string-drop <> (string-length profile)))) + (cons search-path + (string-join (map (lambda (str) + (string-append replacement (crop str))) + items) + separator))))))) + +(define (write-environment-variable-definition port) + "Write the given environment variable definition to PORT." + (match-lambda + ((search-path . value) + (display (search-path-definition search-path value #:kind 'prefix) + port) + (newline port)))) + +(define (build-etc/profile output search-paths) + "Build the 'OUTPUT/etc/profile' shell file containing environment variable +definitions for all the SEARCH-PATHS." + (mkdir-p (string-append output "/etc")) + (call-with-output-file (string-append output "/etc/profile") + (lambda (port) + ;; The use of $GUIX_PROFILE described below is not great. Another + ;; option would have been to use "$1" and have users run: + ;; + ;; source ~/.guix-profile/etc/profile ~/.guix-profile + ;; + ;; However, when 'source' is used with no arguments, $1 refers to the + ;; first positional parameter of the calling scripts, so we can rely on + ;; it. + (display "\ +# Source this file to define all the relevant environment variables in Bash +# for this profile. You may want to define the 'GUIX_PROFILE' environment +# variable to point to the \"visible\" name of the profile, like this: +# +# GUIX_PROFILE=/path/to/profile +# source /path/to/profile/etc/profile +# +# When GUIX_PROFILE is undefined, the various environment variables refer +# to this specific profile generation. +\n" port) + (let ((variables (evaluate-search-paths (cons $PATH search-paths) + (list output)))) + (for-each (write-environment-variable-definition port) + (map (abstract-profile output) variables)))))) + +(define (ensure-writable-directory directory) + "Ensure DIRECTORY exists and is writable. If DIRECTORY is currently a +symlink (to a read-only directory in the store), then delete the symlink and +instead make DIRECTORY a \"real\" directory containing symlinks." + (define (unsymlink link) + (let* ((target (readlink link)) + ;; TARGET might itself be a symlink, so append "/" to make sure + ;; 'scandir' enters it. + (files (scandir (string-append target "/") + (negate (cut member <> '("." "..")))))) + (delete-file link) + (mkdir link) + (for-each (lambda (file) + (symlink (string-append target "/" file) + (string-append link "/" file))) + files))) + + (catch 'system-error + (lambda () + (mkdir directory)) + (lambda args + (let ((errno (system-error-errno args))) + (if (= errno EEXIST) + (let ((stat (lstat directory))) + (case (stat:type stat) + ((symlink) + ;; "Unsymlink" DIRECTORY so that it is writable. + (unsymlink directory)) + ((directory) + #t) + (else + (error "cannot mkdir because a same-named file exists" + directory)))) + (apply throw args)))))) + +(define* (build-profile output inputs + #:key manifest search-paths) + "Build a user profile from INPUTS in directory OUTPUT. Write MANIFEST, an +sexp, to OUTPUT/manifest. Create OUTPUT/etc/profile with Bash definitions for +-all the variables listed in SEARCH-PATHS." + ;; Make the symlinks. + (union-build output inputs + #:log-port (%make-void-port "w")) + + ;; Store meta-data. + (call-with-output-file (string-append output "/manifest") + (lambda (p) + (pretty-print manifest p))) + + ;; Make sure we can write to 'OUTPUT/etc'. 'union-build' above could have + ;; made 'etc' a symlink to a read-only sub-directory in the store so we need + ;; to work around that. + (ensure-writable-directory (string-append output "/etc")) + + ;; Write 'OUTPUT/etc/profile'. + (build-etc/profile output search-paths)) + +;;; profile.scm ends here |