me
/
guix
Archived
1
0
Fork 0

pack: Build the store database under a UTF-8 locale.

Fixes <https://bugs.gnu.org/42389>.
Reported by branjam4@gmail.com.

* guix/scripts/pack.scm (store-database)[build]: Add calls to 'setenv'
and 'setlocale'.
* tests/pack.scm ("self-contained-tarball + localstatedir, UTF-8 file
names"): New test.
master
Ludovic Courtès 2020-07-20 16:12:29 +02:00
parent 181e0dddd6
commit b3802495f6
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 62 additions and 1 deletions

View File

@ -149,6 +149,11 @@ dependencies are registered."
(define db-file
(store-database-file #:state-directory #$output))
;; Make sure non-ASCII file names are properly handled.
(setenv "GUIX_LOCPATH"
#+(file-append glibc-utf8-locales "/lib/locale"))
(setlocale LC_ALL "en_US.utf8")
(sql-schema #$schema)
(let ((items (append-map read-closure '#$labels)))
(with-database db-file db

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
@ -27,8 +27,13 @@
#:use-module (guix grafts)
#:use-module (guix tests)
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (gnu packages)
#:use-module ((gnu packages base) #:select (glibc-utf8-locales))
#:use-module (gnu packages bootstrap)
#:use-module ((gnu packages compression) #:select (squashfs-tools))
#:use-module ((gnu packages guile) #:select (guile-sqlite3))
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
#:use-module (srfi srfi-64))
(define %store
@ -136,6 +141,57 @@
(readlink bin))))))))
(built-derivations (list check))))
(unless store (test-skip 1))
(test-assertm "self-contained-tarball + localstatedir, UTF-8 file names" store
(mlet* %store-monad
((guile (set-guile-for-build (default-guile)))
(tree (interned-file-tree
`("directory-with-utf8-file-names" directory
("α" regular (data "alpha"))
("λ" regular (data "lambda")))))
(tarball (self-contained-tarball "tar-pack" tree
#:localstatedir? #t))
(check (gexp->derivation
"check-tarball"
(with-extensions (list guile-sqlite3 guile-gcrypt)
(with-imported-modules (source-module-closure
'((guix store database)))
#~(begin
(use-modules (guix store database)
(rnrs io ports)
(srfi srfi-1))
(define (valid-file? basename data)
(define file
(string-append "./" #$tree "/" basename))
(string=? (call-with-input-file (pk 'file file)
get-string-all)
data))
(setenv "PATH"
(string-append #$%tar-bootstrap "/bin"))
(system* "tar" "xvf" #$tarball)
(sql-schema
#$(local-file (search-path %load-path
"guix/store/schema.sql")))
(with-database "var/guix/db/db.sqlite" db
;; Make sure non-ASCII file names are properly
;; handled.
(setenv "GUIX_LOCPATH"
#+(file-append glibc-utf8-locales
"/lib/locale"))
(setlocale LC_ALL "en_US.utf8")
(mkdir #$output)
(exit
(and (every valid-file?
'("α" "λ")
'("alpha" "lambda"))
(integer? (path-id db #$tree)))))))))))
(built-derivations (list check))))
(unless store (test-skip 1))
(test-assertm "docker-image + localstatedir" store
(mlet* %store-monad