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

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit b3802495f607fd5e17c5acf0be2ee014036e2464
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Jul 20 16:12:29 2020 +0200

    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.
---
 guix/scripts/pack.scm |  5 +++++
 tests/pack.scm        | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 62 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 51afaeb..13ade37 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -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
diff --git a/tests/pack.scm b/tests/pack.scm
index cb7e110..e8455b4 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 @@
   #: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
@@ -137,6 +142,57 @@
       (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
         ((guile   (set-guile-for-build (default-guile)))