search-paths.scm 10 KB

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