From b3802495f607fd5e17c5acf0be2ee014036e2464 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 20 Jul 2020 16:12:29 +0200
Subject: 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.
---
 tests/pack.scm | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 57 insertions(+), 1 deletion(-)

(limited to 'tests')

diff --git a/tests/pack.scm b/tests/pack.scm
index cb7e110d18..e8455b4f37 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -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 @@ (define-module (test-pack)
   #: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 @@ (define bin
                                        (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
-- 
cgit v1.2.3