store: Fix many guix commands failing on some locales.
Partly fixes <https://bugs.gnu.org/39970>. At least 'guix environment', 'guix install' and 'guix pull' on 'az_AZ.utf8' and 'tr_TR.utf8' were affected. * guix/store.scm (store-path-hash-part): Move base path detection to ... (store-path-base): ... this new exported procedure. (store-path-package-name): Use it instead of locale-dependent regexps. (store-regexp*): Remove.
This commit is contained in:
parent
6794653e1b
commit
771c5e155d
@ -2,6 +2,7 @@
|
|||||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
|
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||||
;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
|
;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||||
|
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
@ -43,7 +44,6 @@
|
|||||||
#:use-module (srfi srfi-35)
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module (srfi srfi-39)
|
#:use-module (srfi srfi-39)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 regex)
|
|
||||||
#:use-module (ice-9 vlist)
|
#:use-module (ice-9 vlist)
|
||||||
#:use-module (ice-9 popen)
|
#:use-module (ice-9 popen)
|
||||||
#:use-module (ice-9 threads)
|
#:use-module (ice-9 threads)
|
||||||
@ -173,6 +173,7 @@
|
|||||||
store-path?
|
store-path?
|
||||||
direct-store-path?
|
direct-store-path?
|
||||||
derivation-path?
|
derivation-path?
|
||||||
|
store-path-base
|
||||||
store-path-package-name
|
store-path-package-name
|
||||||
store-path-hash-part
|
store-path-hash-part
|
||||||
direct-store-path
|
direct-store-path
|
||||||
@ -1949,29 +1950,26 @@ valid inputs."
|
|||||||
"Return #t if PATH is a derivation path."
|
"Return #t if PATH is a derivation path."
|
||||||
(and (store-path? path) (string-suffix? ".drv" path)))
|
(and (store-path? path) (string-suffix? ".drv" path)))
|
||||||
|
|
||||||
(define store-regexp*
|
(define (store-path-base path)
|
||||||
;; The substituter makes repeated calls to 'store-path-hash-part', hence
|
"Return the base path of a path in the store."
|
||||||
;; this optimization.
|
(and (string-prefix? (%store-prefix) path)
|
||||||
(mlambda (store)
|
(let ((base (string-drop path (+ 1 (string-length (%store-prefix))))))
|
||||||
"Return a regexp matching a file in STORE."
|
(and (> (string-length base) 33)
|
||||||
(make-regexp (string-append "^" (regexp-quote store)
|
(not (string-index base #\/))
|
||||||
"/([0-9a-df-np-sv-z]{32})-([^/]+)$"))))
|
base))))
|
||||||
|
|
||||||
(define (store-path-package-name path)
|
(define (store-path-package-name path)
|
||||||
"Return the package name part of PATH, a file name in the store."
|
"Return the package name part of PATH, a file name in the store."
|
||||||
(let ((path-rx (store-regexp* (%store-prefix))))
|
(let ((base (store-path-base path)))
|
||||||
(and=> (regexp-exec path-rx path)
|
(string-drop base (+ 32 1)))) ;32 hash part + 1 hyphen
|
||||||
(cut match:substring <> 2))))
|
|
||||||
|
|
||||||
(define (store-path-hash-part path)
|
(define (store-path-hash-part path)
|
||||||
"Return the hash part of PATH as a base32 string, or #f if PATH is not a
|
"Return the hash part of PATH as a base32 string, or #f if PATH is not a
|
||||||
syntactically valid store path."
|
syntactically valid store path."
|
||||||
(and (string-prefix? (%store-prefix) path)
|
(let* ((base (store-path-base path))
|
||||||
(let ((base (string-drop path (+ 1 (string-length (%store-prefix))))))
|
(hash (string-take base 32)))
|
||||||
(and (> (string-length base) 33)
|
(and (string-every %nix-base32-charset hash)
|
||||||
(let ((hash (string-take base 32)))
|
hash)))
|
||||||
(and (string-every %nix-base32-charset hash)
|
|
||||||
hash))))))
|
|
||||||
|
|
||||||
(define (derivation-log-file drv)
|
(define (derivation-log-file drv)
|
||||||
"Return the build log file for DRV, a derivation file name, or #f if it
|
"Return the build log file for DRV, a derivation file name, or #f if it
|
||||||
|
Loading…
Reference in New Issue
Block a user