guix/search-paths.scm

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