Commit | Line | Data |
---|---|---|
611adb1e | 1 | ;;; GNU Guix --- Functional package management for GNU |
e00ade3f | 2 | ;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org> |
611adb1e LC |
3 | ;;; |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix build profiles) | |
20 | #:use-module (guix build union) | |
d664f1b4 LC |
21 | #:use-module (guix build utils) |
22 | #:use-module (guix search-paths) | |
23 | #:use-module (srfi srfi-26) | |
a0dac7a0 | 24 | #:use-module (ice-9 ftw) |
d664f1b4 | 25 | #:use-module (ice-9 match) |
611adb1e | 26 | #:use-module (ice-9 pretty-print) |
e00ade3f | 27 | #:re-export (symlink-relative) ;for convenience |
6a669bda LC |
28 | #:export (ensure-writable-directory |
29 | build-profile)) | |
611adb1e LC |
30 | |
31 | ;;; Commentary: | |
32 | ;;; | |
33 | ;;; Build a user profile (essentially the union of all the installed packages) | |
34 | ;;; with its associated meta-data. | |
35 | ;;; | |
36 | ;;; Code: | |
37 | ||
d664f1b4 LC |
38 | (define (abstract-profile profile) |
39 | "Return a procedure that replaces PROFILE in VALUE with a reference to the | |
40 | 'GUIX_PROFILE' environment variable. This allows users to specify what the | |
41 | user-friendly name of the profile is, for instance ~/.guix-profile rather than | |
42 | /gnu/store/...-profile." | |
fcd75bdb LC |
43 | (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}")) |
44 | (crop (cute string-drop <> (string-length profile)))) | |
d664f1b4 LC |
45 | (match-lambda |
46 | ((search-path . value) | |
fcd75bdb LC |
47 | (match (search-path-specification-separator search-path) |
48 | (#f | |
49 | (cons search-path | |
50 | (string-append replacement (crop value)))) | |
51 | ((? string? separator) | |
52 | (let ((items (string-tokenize* value separator))) | |
53 | (cons search-path | |
54 | (string-join (map (lambda (str) | |
55 | (string-append replacement (crop str))) | |
56 | items) | |
57 | separator))))))))) | |
d664f1b4 LC |
58 | |
59 | (define (write-environment-variable-definition port) | |
60 | "Write the given environment variable definition to PORT." | |
61 | (match-lambda | |
62 | ((search-path . value) | |
63 | (display (search-path-definition search-path value #:kind 'prefix) | |
64 | port) | |
65 | (newline port)))) | |
66 | ||
a0dac7a0 LC |
67 | (define (build-etc/profile output search-paths) |
68 | "Build the 'OUTPUT/etc/profile' shell file containing environment variable | |
69 | definitions for all the SEARCH-PATHS." | |
d664f1b4 LC |
70 | (mkdir-p (string-append output "/etc")) |
71 | (call-with-output-file (string-append output "/etc/profile") | |
72 | (lambda (port) | |
73 | ;; The use of $GUIX_PROFILE described below is not great. Another | |
74 | ;; option would have been to use "$1" and have users run: | |
75 | ;; | |
76 | ;; source ~/.guix-profile/etc/profile ~/.guix-profile | |
77 | ;; | |
78 | ;; However, when 'source' is used with no arguments, $1 refers to the | |
5537f2d2 LC |
79 | ;; first positional parameter of the calling script, so we cannot rely |
80 | ;; on it. | |
d664f1b4 LC |
81 | (display "\ |
82 | # Source this file to define all the relevant environment variables in Bash | |
83 | # for this profile. You may want to define the 'GUIX_PROFILE' environment | |
84 | # variable to point to the \"visible\" name of the profile, like this: | |
85 | # | |
bd7e136d | 86 | # GUIX_PROFILE=/path/to/profile ; \\ |
d664f1b4 LC |
87 | # source /path/to/profile/etc/profile |
88 | # | |
89 | # When GUIX_PROFILE is undefined, the various environment variables refer | |
90 | # to this specific profile generation. | |
91 | \n" port) | |
92 | (let ((variables (evaluate-search-paths (cons $PATH search-paths) | |
93 | (list output)))) | |
94 | (for-each (write-environment-variable-definition port) | |
95 | (map (abstract-profile output) variables)))))) | |
611adb1e | 96 | |
a0dac7a0 LC |
97 | (define (ensure-writable-directory directory) |
98 | "Ensure DIRECTORY exists and is writable. If DIRECTORY is currently a | |
99 | symlink (to a read-only directory in the store), then delete the symlink and | |
100 | instead make DIRECTORY a \"real\" directory containing symlinks." | |
101 | (define (unsymlink link) | |
102 | (let* ((target (readlink link)) | |
113c17a0 LC |
103 | ;; TARGET might itself be a symlink, so append "/" to make sure |
104 | ;; 'scandir' enters it. | |
105 | (files (scandir (string-append target "/") | |
a0dac7a0 LC |
106 | (negate (cut member <> '("." "..")))))) |
107 | (delete-file link) | |
108 | (mkdir link) | |
109 | (for-each (lambda (file) | |
110 | (symlink (string-append target "/" file) | |
111 | (string-append link "/" file))) | |
112 | files))) | |
113 | ||
114 | (catch 'system-error | |
115 | (lambda () | |
116 | (mkdir directory)) | |
117 | (lambda args | |
118 | (let ((errno (system-error-errno args))) | |
119 | (if (= errno EEXIST) | |
120 | (let ((stat (lstat directory))) | |
121 | (case (stat:type stat) | |
122 | ((symlink) | |
123 | ;; "Unsymlink" DIRECTORY so that it is writable. | |
124 | (unsymlink directory)) | |
125 | ((directory) | |
126 | #t) | |
127 | (else | |
128 | (error "cannot mkdir because a same-named file exists" | |
129 | directory)))) | |
130 | (apply throw args)))))) | |
131 | ||
132 | (define* (build-profile output inputs | |
e00ade3f LC |
133 | #:key manifest search-paths |
134 | (symlink symlink)) | |
135 | "Build a user profile from INPUTS in directory OUTPUT, using SYMLINK to | |
136 | create symlinks. Write MANIFEST, an sexp, to OUTPUT/manifest. Create | |
137 | OUTPUT/etc/profile with Bash definitions for -all the variables listed in | |
138 | SEARCH-PATHS." | |
a0dac7a0 LC |
139 | ;; Make the symlinks. |
140 | (union-build output inputs | |
e00ade3f | 141 | #:symlink symlink |
a0dac7a0 LC |
142 | #:log-port (%make-void-port "w")) |
143 | ||
144 | ;; Store meta-data. | |
145 | (call-with-output-file (string-append output "/manifest") | |
146 | (lambda (p) | |
147 | (pretty-print manifest p))) | |
148 | ||
149 | ;; Make sure we can write to 'OUTPUT/etc'. 'union-build' above could have | |
150 | ;; made 'etc' a symlink to a read-only sub-directory in the store so we need | |
151 | ;; to work around that. | |
152 | (ensure-writable-directory (string-append output "/etc")) | |
153 | ||
154 | ;; Write 'OUTPUT/etc/profile'. | |
155 | (build-etc/profile output search-paths)) | |
156 | ||
611adb1e | 157 | ;;; profile.scm ends here |