summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-01-22 22:42:57 +0100
committerLudovic Courtès <ludo@gnu.org>2017-01-23 22:23:41 +0100
commitfcd75bdbfa99d14363b905afbf914eec20e69df8 (patch)
tree38f9cfaf9c186fc6c9af54183efbd02fa1a13f70
parentc5746f239964a72642ac56640b8ff490d5bfa673 (diff)
search-paths: Allow specs with #f as their separator.
This adds support for single-entry search paths. Fixes <http://bugs.gnu.org/25422>. Reported by Leo Famulari <leo@famulari.name>. * guix/search-paths.scm (<search-path-specification>)[separator]: Document as string or #f. (evaluate-search-paths): Add case for SEPARATOR as #f. (environment-variable-definition): Handle SEPARATOR being #f. * guix/build/utils.scm (list->search-path-as-string): Add case for SEPARATOR as #f. (search-path-as-string->list): Likewise. * guix/build/profiles.scm (abstract-profile): Likewise. * tests/search-paths.scm: New file. * Makefile.am (SCM_TESTS): Add it. * tests/packages.scm ("--search-paths with single-item search path"): New test. * gnu/packages/version-control.scm (git)[native-search-paths](separator): New field.
-rw-r--r--Makefile.am3
-rw-r--r--gnu/packages/version-control.scm4
-rw-r--r--guix/build/profiles.scm24
-rw-r--r--guix/build/utils.scm13
-rw-r--r--guix/search-paths.scm28
-rw-r--r--tests/packages.scm49
-rw-r--r--tests/search-paths.scm48
7 files changed, 144 insertions, 25 deletions
diff --git a/Makefile.am b/Makefile.am
index 3e147df2e03..dd9069ea768 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,5 +1,5 @@
1# GNU Guix --- Functional package management for GNU 1# GNU Guix --- Functional package management for GNU
2# Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> 2# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
3# Copyright © 2013 Andreas Enge <andreas@enge.fr> 3# Copyright © 2013 Andreas Enge <andreas@enge.fr>
4# Copyright © 2015 Alex Kost <alezost@gmail.com> 4# Copyright © 2015 Alex Kost <alezost@gmail.com>
5# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> 5# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
@@ -272,6 +272,7 @@ SCM_TESTS = \
272 tests/nar.scm \ 272 tests/nar.scm \
273 tests/union.scm \ 273 tests/union.scm \
274 tests/profiles.scm \ 274 tests/profiles.scm \
275 tests/search-paths.scm \
275 tests/syscalls.scm \ 276 tests/syscalls.scm \
276 tests/gremlin.scm \ 277 tests/gremlin.scm \
277 tests/bournish.scm \ 278 tests/bournish.scm \
diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index 7918b90ca6c..bf1842010f2 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -1,7 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> 2;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
3;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> 3;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
4;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> 4;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
5;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr> 5;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
6;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> 6;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
7;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org> 7;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org>
@@ -297,10 +297,10 @@ as well as the classic centralized workflow.")
297 (native-search-paths 297 (native-search-paths
298 ;; For HTTPS access, Git needs a single-file certificate bundle, specified 298 ;; For HTTPS access, Git needs a single-file certificate bundle, specified
299 ;; with $GIT_SSL_CAINFO. 299 ;; with $GIT_SSL_CAINFO.
300 ;; FIXME: This variable designates a single file; it is not a search path.
301 (list (search-path-specification 300 (list (search-path-specification
302 (variable "GIT_SSL_CAINFO") 301 (variable "GIT_SSL_CAINFO")
303 (file-type 'regular) 302 (file-type 'regular)
303 (separator #f) ;single entry
304 (files '("etc/ssl/certs/ca-certificates.crt"))))) 304 (files '("etc/ssl/certs/ca-certificates.crt")))))
305 305
306 (synopsis "Distributed version control system") 306 (synopsis "Distributed version control system")
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 6e316d5d2c4..42eabfaf19e 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -39,17 +39,21 @@
39'GUIX_PROFILE' environment variable. This allows users to specify what the 39'GUIX_PROFILE' environment variable. This allows users to specify what the
40user-friendly name of the profile is, for instance ~/.guix-profile rather than 40user-friendly name of the profile is, for instance ~/.guix-profile rather than
41/gnu/store/...-profile." 41/gnu/store/...-profile."
42 (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}"))) 42 (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}"))
43 (crop (cute string-drop <> (string-length profile))))
43 (match-lambda 44 (match-lambda
44 ((search-path . value) 45 ((search-path . value)
45 (let* ((separator (search-path-specification-separator search-path)) 46 (match (search-path-specification-separator search-path)
46 (items (string-tokenize* value separator)) 47 (#f
47 (crop (cute string-drop <> (string-length profile)))) 48 (cons search-path
48 (cons search-path 49 (string-append replacement (crop value))))
49 (string-join (map (lambda (str) 50 ((? string? separator)
50 (string-append replacement (crop str))) 51 (let ((items (string-tokenize* value separator)))
51 items) 52 (cons search-path
52 separator))))))) 53 (string-join (map (lambda (str)
54 (string-append replacement (crop str)))
55 items)
56 separator)))))))))
53 57
54(define (write-environment-variable-definition port) 58(define (write-environment-variable-definition port)
55 "Write the given environment variable definition to PORT." 59 "Write the given environment variable definition to PORT."
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index bc6f114152e..cf093263936 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> 3;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
4;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> 4;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
5;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> 5;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
@@ -400,10 +400,17 @@ for under the directories designated by FILES. For example:
400 (delete-duplicates input-dirs))) 400 (delete-duplicates input-dirs)))
401 401
402(define (list->search-path-as-string lst separator) 402(define (list->search-path-as-string lst separator)
403 (string-join lst separator)) 403 (if separator
404 (string-join lst separator)
405 (match lst
406 ((head rest ...) head)
407 (() ""))))
404 408
405(define* (search-path-as-string->list path #:optional (separator #\:)) 409(define* (search-path-as-string->list path #:optional (separator #\:))
406 (string-tokenize path (char-set-complement (char-set separator)))) 410 (if separator
411 (string-tokenize path
412 (char-set-complement (char-set separator)))
413 (list path)))
407 414
408(define* (set-path-environment-variable env-var files input-dirs 415(define* (set-path-environment-variable env-var files input-dirs
409 #:key 416 #:key
diff --git a/guix/search-paths.scm b/guix/search-paths.scm
index 7a6fe679595..4bf0e443891 100644
--- a/guix/search-paths.scm
+++ b/guix/search-paths.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -55,7 +55,7 @@
55 search-path-specification? 55 search-path-specification?
56 (variable search-path-specification-variable) ;string 56 (variable search-path-specification-variable) ;string
57 (files search-path-specification-files) ;list of strings 57 (files search-path-specification-files) ;list of strings
58 (separator search-path-specification-separator ;string 58 (separator search-path-specification-separator ;string | #f
59 (default ":")) 59 (default ":"))
60 (file-type search-path-specification-file-type ;symbol 60 (file-type search-path-specification-file-type ;symbol
61 (default 'directory)) 61 (default 'directory))
@@ -131,11 +131,23 @@ like `string-tokenize', but SEPARATOR is a string."
131DIRECTORIES, a list of directory names, and return a list of 131DIRECTORIES, a list of directory names, and return a list of
132specification/value pairs. Use GETENV to determine the current settings and 132specification/value pairs. Use GETENV to determine the current settings and
133report only settings not already effective." 133report only settings not already effective."
134 (define search-path-definition 134 (define (search-path-definition spec)
135 (match-lambda 135 (match spec
136 ((and spec 136 (($ <search-path-specification> variable files #f type pattern)
137 ($ <search-path-specification> variable files separator 137 ;; Separator is #f so return the first match.
138 type pattern)) 138 (match (with-null-error-port
139 (search-path-as-list files directories
140 #:type type
141 #:pattern pattern))
142 (()
143 #f)
144 ((head . _)
145 (let ((value (getenv variable)))
146 (if (and value (string=? value head))
147 #f ;VARIABLE already set appropriately
148 (cons spec head))))))
149 (($ <search-path-specification> variable files separator
150 type pattern)
139 (let* ((values (or (and=> (getenv variable) 151 (let* ((values (or (and=> (getenv variable)
140 (cut string-tokenize* <> separator)) 152 (cut string-tokenize* <> separator))
141 '())) 153 '()))
@@ -164,7 +176,7 @@ current value), or 'suffix (return the definition where VALUE is added as a
164suffix to VARIABLE's current value.) In the case of 'prefix and 'suffix, 176suffix to VARIABLE's current value.) In the case of 'prefix and 'suffix,
165SEPARATOR is used as the separator between VARIABLE's current value and its 177SEPARATOR is used as the separator between VARIABLE's current value and its
166prefix/suffix." 178prefix/suffix."
167 (match kind 179 (match (if (not separator) 'exact kind)
168 ('exact 180 ('exact
169 (format #f "export ~a=\"~a\"" variable value)) 181 (format #f "export ~a=\"~a\"" variable value))
170 ('prefix 182 ('prefix
diff --git a/tests/packages.scm b/tests/packages.scm
index 247f75cc435..962f120ea2c 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -42,6 +42,7 @@
42 #:use-module (gnu packages base) 42 #:use-module (gnu packages base)
43 #:use-module (gnu packages guile) 43 #:use-module (gnu packages guile)
44 #:use-module (gnu packages bootstrap) 44 #:use-module (gnu packages bootstrap)
45 #:use-module (gnu packages version-control)
45 #:use-module (gnu packages xml) 46 #:use-module (gnu packages xml)
46 #:use-module (srfi srfi-1) 47 #:use-module (srfi srfi-1)
47 #:use-module (srfi srfi-26) 48 #:use-module (srfi srfi-26)
@@ -979,6 +980,52 @@
979 (guix-package "-p" (derivation->output-path prof) 980 (guix-package "-p" (derivation->output-path prof)
980 "--search-paths")))))) 981 "--search-paths"))))))
981 982
983(test-assert "--search-paths with single-item search path"
984 ;; Make sure 'guix package --search-paths' correctly reports environment
985 ;; variables for things like 'GIT_SSL_CAINFO' that have #f as their
986 ;; separator, meaning that the first match wins.
987 (let* ((p1 (dummy-package "foo"
988 (build-system trivial-build-system)
989 (arguments
990 `(#:guile ,%bootstrap-guile
991 #:modules ((guix build utils))
992 #:builder (begin
993 (use-modules (guix build utils))
994 (let ((out (assoc-ref %outputs "out")))
995 (mkdir-p (string-append out "/etc/ssl/certs"))
996 (call-with-output-file
997 (string-append
998 out "/etc/ssl/certs/ca-certificates.crt")
999 (const #t))))))))
1000 (p2 (package (inherit p1) (name "bar")))
1001 (p3 (dummy-package "git"
1002 ;; Provide a fake Git to avoid building the real one.
1003 (build-system trivial-build-system)
1004 (arguments
1005 `(#:guile ,%bootstrap-guile
1006 #:builder (mkdir (assoc-ref %outputs "out"))))
1007 (native-search-paths (package-native-search-paths git))))
1008 (prof1 (run-with-store %store
1009 (profile-derivation
1010 (packages->manifest (list p1 p3))
1011 #:hooks '()
1012 #:locales? #f)
1013 #:guile-for-build (%guile-for-build)))
1014 (prof2 (run-with-store %store
1015 (profile-derivation
1016 (packages->manifest (list p2 p3))
1017 #:hooks '()
1018 #:locales? #f)
1019 #:guile-for-build (%guile-for-build))))
1020 (build-derivations %store (list prof1 prof2))
1021 (string-match (format #f "^export GIT_SSL_CAINFO=\"~a/etc/ssl/certs/ca-certificates.crt"
1022 (regexp-quote (derivation->output-path prof1)))
1023 (with-output-to-string
1024 (lambda ()
1025 (guix-package "-p" (derivation->output-path prof1)
1026 "-p" (derivation->output-path prof2)
1027 "--search-paths"))))))
1028
982(test-equal "specification->package when not found" 1029(test-equal "specification->package when not found"
983 'quit 1030 'quit
984 (catch 'quit 1031 (catch 'quit
diff --git a/tests/search-paths.scm b/tests/search-paths.scm
new file mode 100644
index 00000000000..2a4c18dd768
--- /dev/null
+++ b/tests/search-paths.scm
@@ -0,0 +1,48 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
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 (test-search-paths)
20 #:use-module (guix search-paths)
21 #:use-module (ice-9 match)
22 #:use-module (srfi srfi-64))
23
24(define %top-srcdir
25 (dirname (search-path %load-path "guix.scm")))
26
27
28(test-begin "search-paths")
29
30(test-equal "evaluate-search-paths, separator is #f"
31 (string-append %top-srcdir
32 "/gnu/packages/bootstrap/armhf-linux")
33
34 ;; The following search path spec should evaluate to a single item: the
35 ;; first directory that matches the "-linux$" pattern in
36 ;; gnu/packages/bootstrap.
37 (let ((spec (search-path-specification
38 (variable "CHBOUIB")
39 (files '("gnu/packages/bootstrap"))
40 (file-type 'directory)
41 (separator #f)
42 (file-pattern "-linux$"))))
43 (match (evaluate-search-paths (list spec)
44 (list %top-srcdir))
45 (((spec* . value))
46 (and (eq? spec* spec) value)))))
47
48(test-end "search-paths")