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.
This commit is contained in:
parent
c5746f2399
commit
fcd75bdbfa
|
@ -1,5 +1,5 @@
|
|||
# GNU Guix --- Functional package management for GNU
|
||||
# Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
# Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
|
||||
|
@ -272,6 +272,7 @@ SCM_TESTS = \
|
|||
tests/nar.scm \
|
||||
tests/union.scm \
|
||||
tests/profiles.scm \
|
||||
tests/search-paths.scm \
|
||||
tests/syscalls.scm \
|
||||
tests/gremlin.scm \
|
||||
tests/bournish.scm \
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
|
||||
;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org>
|
||||
|
@ -297,10 +297,10 @@ as well as the classic centralized workflow.")
|
|||
(native-search-paths
|
||||
;; For HTTPS access, Git needs a single-file certificate bundle, specified
|
||||
;; with $GIT_SSL_CAINFO.
|
||||
;; FIXME: This variable designates a single file; it is not a search path.
|
||||
(list (search-path-specification
|
||||
(variable "GIT_SSL_CAINFO")
|
||||
(file-type 'regular)
|
||||
(separator #f) ;single entry
|
||||
(files '("etc/ssl/certs/ca-certificates.crt")))))
|
||||
|
||||
(synopsis "Distributed version control system")
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -39,17 +39,21 @@
|
|||
'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 "}")))
|
||||
(let ((replacement (string-append "${GUIX_PROFILE:-" profile "}"))
|
||||
(crop (cute string-drop <> (string-length 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))))
|
||||
(match (search-path-specification-separator search-path)
|
||||
(#f
|
||||
(cons search-path
|
||||
(string-append replacement (crop value))))
|
||||
((? string? separator)
|
||||
(let ((items (string-tokenize* value separator)))
|
||||
(cons search-path
|
||||
(string-join (map (lambda (str)
|
||||
(string-append replacement (crop str)))
|
||||
items)
|
||||
separator)))))))
|
||||
separator)))))))))
|
||||
|
||||
(define (write-environment-variable-definition port)
|
||||
"Write the given environment variable definition to PORT."
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
||||
|
@ -400,10 +400,17 @@ for under the directories designated by FILES. For example:
|
|||
(delete-duplicates input-dirs)))
|
||||
|
||||
(define (list->search-path-as-string lst separator)
|
||||
(string-join lst separator))
|
||||
(if separator
|
||||
(string-join lst separator)
|
||||
(match lst
|
||||
((head rest ...) head)
|
||||
(() ""))))
|
||||
|
||||
(define* (search-path-as-string->list path #:optional (separator #\:))
|
||||
(string-tokenize path (char-set-complement (char-set separator))))
|
||||
(if separator
|
||||
(string-tokenize path
|
||||
(char-set-complement (char-set separator)))
|
||||
(list path)))
|
||||
|
||||
(define* (set-path-environment-variable env-var files input-dirs
|
||||
#:key
|
||||
|
|
|
@ -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, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -55,7 +55,7 @@
|
|||
search-path-specification?
|
||||
(variable search-path-specification-variable) ;string
|
||||
(files search-path-specification-files) ;list of strings
|
||||
(separator search-path-specification-separator ;string
|
||||
(separator search-path-specification-separator ;string | #f
|
||||
(default ":"))
|
||||
(file-type search-path-specification-file-type ;symbol
|
||||
(default 'directory))
|
||||
|
@ -131,11 +131,23 @@ like `string-tokenize', but SEPARATOR is a string."
|
|||
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
|
||||
(match-lambda
|
||||
((and spec
|
||||
($ <search-path-specification> variable files separator
|
||||
type pattern))
|
||||
(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))
|
||||
'()))
|
||||
|
@ -164,7 +176,7 @@ 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 kind
|
||||
(match (if (not separator) 'exact kind)
|
||||
('exact
|
||||
(format #f "export ~a=\"~a\"" variable value))
|
||||
('prefix
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -42,6 +42,7 @@
|
|||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages guile)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (gnu packages version-control)
|
||||
#:use-module (gnu packages xml)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
|
@ -979,6 +980,52 @@
|
|||
(guix-package "-p" (derivation->output-path prof)
|
||||
"--search-paths"))))))
|
||||
|
||||
(test-assert "--search-paths with single-item search path"
|
||||
;; Make sure 'guix package --search-paths' correctly reports environment
|
||||
;; variables for things like 'GIT_SSL_CAINFO' that have #f as their
|
||||
;; separator, meaning that the first match wins.
|
||||
(let* ((p1 (dummy-package "foo"
|
||||
(build-system trivial-build-system)
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:modules ((guix build utils))
|
||||
#:builder (begin
|
||||
(use-modules (guix build utils))
|
||||
(let ((out (assoc-ref %outputs "out")))
|
||||
(mkdir-p (string-append out "/etc/ssl/certs"))
|
||||
(call-with-output-file
|
||||
(string-append
|
||||
out "/etc/ssl/certs/ca-certificates.crt")
|
||||
(const #t))))))))
|
||||
(p2 (package (inherit p1) (name "bar")))
|
||||
(p3 (dummy-package "git"
|
||||
;; Provide a fake Git to avoid building the real one.
|
||||
(build-system trivial-build-system)
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:builder (mkdir (assoc-ref %outputs "out"))))
|
||||
(native-search-paths (package-native-search-paths git))))
|
||||
(prof1 (run-with-store %store
|
||||
(profile-derivation
|
||||
(packages->manifest (list p1 p3))
|
||||
#:hooks '()
|
||||
#:locales? #f)
|
||||
#:guile-for-build (%guile-for-build)))
|
||||
(prof2 (run-with-store %store
|
||||
(profile-derivation
|
||||
(packages->manifest (list p2 p3))
|
||||
#:hooks '()
|
||||
#:locales? #f)
|
||||
#:guile-for-build (%guile-for-build))))
|
||||
(build-derivations %store (list prof1 prof2))
|
||||
(string-match (format #f "^export GIT_SSL_CAINFO=\"~a/etc/ssl/certs/ca-certificates.crt"
|
||||
(regexp-quote (derivation->output-path prof1)))
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(guix-package "-p" (derivation->output-path prof1)
|
||||
"-p" (derivation->output-path prof2)
|
||||
"--search-paths"))))))
|
||||
|
||||
(test-equal "specification->package when not found"
|
||||
'quit
|
||||
(catch 'quit
|
||||
|
|
|
@ -0,0 +1,48 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2017 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 (test-search-paths)
|
||||
#:use-module (guix search-paths)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-64))
|
||||
|
||||
(define %top-srcdir
|
||||
(dirname (search-path %load-path "guix.scm")))
|
||||
|
||||
|
||||
(test-begin "search-paths")
|
||||
|
||||
(test-equal "evaluate-search-paths, separator is #f"
|
||||
(string-append %top-srcdir
|
||||
"/gnu/packages/bootstrap/armhf-linux")
|
||||
|
||||
;; The following search path spec should evaluate to a single item: the
|
||||
;; first directory that matches the "-linux$" pattern in
|
||||
;; gnu/packages/bootstrap.
|
||||
(let ((spec (search-path-specification
|
||||
(variable "CHBOUIB")
|
||||
(files '("gnu/packages/bootstrap"))
|
||||
(file-type 'directory)
|
||||
(separator #f)
|
||||
(file-pattern "-linux$"))))
|
||||
(match (evaluate-search-paths (list spec)
|
||||
(list %top-srcdir))
|
||||
(((spec* . value))
|
||||
(and (eq? spec* spec) value)))))
|
||||
|
||||
(test-end "search-paths")
|
Loading…
Reference in New Issue