1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
|
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; 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 search-paths)
#:use-module (guix records)
#:use-module (guix build utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (<search-path-specification>
search-path-specification
search-path-specification?
search-path-specification-variable
search-path-specification-files
search-path-specification-separator
search-path-specification-file-type
search-path-specification-file-pattern
$PATH
$SSL_CERT_DIR
$SSL_CERT_FILE
search-path-specification->sexp
sexp->search-path-specification
string-tokenize*
evaluate-search-paths
environment-variable-definition
search-path-definition
set-search-paths))
;;; Commentary:
;;;
;;; This module defines "search path specifications", which allow packages to
;;; declare environment variables that they use to define search paths. For
;;; instance, GCC has the 'CPATH' variable, Guile has the 'GUILE_LOAD_PATH'
;;; variable, etc.
;;;
;;; Code:
;; The specification of a search path.
(define-record-type* <search-path-specification>
search-path-specification make-search-path-specification
search-path-specification?
(variable search-path-specification-variable) ;string
(files search-path-specification-files) ;list of strings
(separator search-path-specification-separator ;string | #f
(default ":"))
(file-type search-path-specification-file-type ;symbol
(default 'directory))
(file-pattern search-path-specification-file-pattern ;#f | string
(default #f)))
(define $PATH
;; The 'PATH' variable. This variable is a bit special: it is not attached
;; to any package in particular.
(search-path-specification
(variable "PATH")
(files '("bin" "sbin"))))
;; Two variables for certificates (see (guix)X.509 Certificates),
;; respected by 'openssl', possibly GnuTLS in the future
;; (https://gitlab.com/gnutls/gnutls/-/merge_requests/1541)
;; and many of their dependents -- even some GnuTLS depepdents
;; like Guile. As they are not tied to a single package, define
;; them here to avoid duplication.
;;
;; Additionally, the 'native-search-paths' field is not thunked,
;; so doing (package-native-search-paths openssl)
;; could cause import cycle issues.
(define-public $SSL_CERT_DIR
(search-path-specification
(variable "SSL_CERT_DIR")
(separator #f) ;single entry
(files '("etc/ssl/certs"))))
(define-public $SSL_CERT_FILE
(search-path-specification
(variable "SSL_CERT_FILE")
(file-type 'regular)
(separator #f) ;single entry
(files '("etc/ssl/certs/ca-certificates.crt"))))
(define (search-path-specification->sexp spec)
"Return an sexp representing SPEC, a <search-path-specification>. The sexp
corresponds to the arguments expected by `set-path-environment-variable'."
;; Note that this sexp format is used both by build systems and in
;; (guix profiles), so think twice before you change it.
(match spec
(($ <search-path-specification> variable files separator type pattern)
`(,variable ,files ,separator ,type ,pattern))))
(define (sexp->search-path-specification sexp)
"Convert SEXP, which is as returned by 'search-path-specification->sexp', to
a <search-path-specification> object."
(match sexp
((variable files separator type pattern)
(search-path-specification
(variable variable)
(files files)
(separator separator)
(file-type type)
(file-pattern pattern)))))
(define-syntax-rule (with-null-error-port exp)
"Evaluate EXP with the error port pointing to the bit bucket."
(with-error-to-port (%make-void-port "w")
(lambda () exp)))
;; XXX: This procedure used to be in (guix utils) but since we want to be able
;; to use (guix search-paths) on the build side, we want to avoid the
;; dependency on (guix utils), and so this procedure is back here for now.
(define (string-tokenize* string separator)
"Return the list of substrings of STRING separated by SEPARATOR. This is
like `string-tokenize', but SEPARATOR is a string."
(define (index string what)
(let loop ((string string)
(offset 0))
(cond ((string-null? string)
#f)
((string-prefix? what string)
offset)
(else
(loop (string-drop string 1) (+ 1 offset))))))
(define len
(string-length separator))
(let loop ((string string)
(result '()))
(cond ((index string separator)
=>
(lambda (offset)
(loop (string-drop string (+ offset len))
(cons (substring string 0 offset)
result))))
(else
(reverse (cons string result))))))
(define* (evaluate-search-paths search-paths directories
#:optional (getenv (const #f)))
"Evaluate SEARCH-PATHS, a list of search-path specifications, for
DIRECTORIES, a list of directory names, and return a list of
specification/value pairs. Use GETENV to determine the current settings and
report only settings not already effective."
(define (search-path-definition spec)
(match spec
(($ <search-path-specification> variable files #f type pattern)
;; Separator is #f so return the first match.
(match (with-null-error-port
(search-path-as-list files directories
#:type type
#:pattern pattern))
(()
#f)
((head . _)
(let ((value (getenv variable)))
(if (and value (string=? value head))
#f ;VARIABLE already set appropriately
(cons spec head))))))
(($ <search-path-specification> variable files separator
type pattern)
(let* ((values (or (and=> (getenv variable)
(cut string-tokenize* <> separator))
'()))
;; XXX: Silence 'find-files' when it stumbles upon non-existent
;; directories (see
;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.)
(path (with-null-error-port
(search-path-as-list files directories
#:type type
#:pattern pattern))))
(if (every (cut member <> values) path)
#f ;VARIABLE is already set appropriately
(cons spec (string-join path separator)))))))
(filter-map search-path-definition search-paths))
(define* (environment-variable-definition variable value
#:key
(kind 'exact)
(separator ":"))
"Return a the definition of VARIABLE to VALUE in Bash syntax.
KIND can be either 'exact (return the definition of VARIABLE=VALUE),
'prefix (return the definition where VALUE is added as a prefix to VARIABLE's
current value), or 'suffix (return the definition where VALUE is added as a
suffix to VARIABLE's current value.) In the case of 'prefix and 'suffix,
SEPARATOR is used as the separator between VARIABLE's current value and its
prefix/suffix."
(match (if (not separator) 'exact kind)
('exact
(format #f "export ~a=\"~a\"" variable value))
('prefix
(format #f "export ~a=\"~a${~a:+~a}$~a\""
variable value variable separator variable))
('suffix
(format #f "export ~a=\"$~a${~a:+~a}~a\""
variable variable variable separator value))))
(define* (search-path-definition search-path value
#:key (kind 'exact))
"Similar to 'environment-variable-definition', but applied to a
<search-path-specification>."
(match search-path
(($ <search-path-specification> variable _ separator)
(environment-variable-definition variable value
#:kind kind
#:separator separator))))
(define* (set-search-paths search-paths directories
#:key (setenv setenv))
"Set the search path environment variables specified by SEARCH-PATHS for the
given directories."
(for-each (match-lambda
((spec . value)
(setenv (search-path-specification-variable spec)
value)))
(evaluate-search-paths search-paths directories)))
;;; search-paths.scm ends here
|
