ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

search-paths: Allow specs with #f as their separator.

Browse source 
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:
Ludovic Courtès 2017-01-22 22:42:57 +01:00
parent c5746f2399
commit fcd75bdbfa
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
7 changed files with 144 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile.am
View file

@ -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 \

4
gnu/packages/version-control.scm
View file

@ -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 @@ (define-public git
(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")

24
guix/build/profiles.scm
View file

@ -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 @@ (define (abstract-profile profile)
'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))))
(cons search-path
(string-join (map (lambda (str)
(string-append replacement (crop str)))
items)
separator)))))))
(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)))))))))
(define (write-environment-variable-definition port)
"Write the given environment variable definition to PORT."

13
guix/build/utils.scm
View file

@ -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 @@ (define* (search-path-as-list files input-dirs
(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

28
guix/search-paths.scm
View file

@ -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 @@ (define-record-type* <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
(separator search-path-specification-separator ;string | #f
(default ":"))
(file-type search-path-specification-file-type ;symbol
(default 'directory))
@ -131,11 +131,23 @@ (define* (evaluate-search-paths search-paths directories
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 @@ (define* (environment-variable-definition variable value
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

49
tests/packages.scm
View file

@ -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 @@ (define-module (test-packages)
#: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 @@ (define read-at
(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

48
tests/search-paths.scm Normal file
View file

@ -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")