02/02: services: cleanup: Expect file names to be UTF-8-encoded.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 76c321d8e85683091ecbcd3afe8c56fb7c45c00a
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jun 20 10:00:44 2018 +0200

    services: cleanup: Expect file names to be UTF-8-encoded.
    
    Fixes <https://bugs.gnu.org/26353>.
    Reported by Danny Milosavljevic <address@hidden>.
    
    * gnu/services.scm (cleanup-gexp): Add 'setenv' and 'setlocale' calls
    before 'delete-file-recursively'.
    * gnu/tests/base.scm (%cleanup-os, %test-cleanup): New variables.
    (run-cleanup-test): New procedure.
---
 gnu/services.scm   |  6 +++++
 gnu/tests/base.scm | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 77 insertions(+)

diff --git a/gnu/services.scm b/gnu/services.scm
index 3162c6b..55ad5c9 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -394,8 +394,14 @@ boot."
                      (delete-file "/etc/passwd.lock")
                      (delete-file "/etc/.pwd.lock") ;from 'lckpwdf'
 
+                     ;; Force file names to be decoded as UTF-8.  See
+                     ;; <https://bugs.gnu.org/26353>.
+                     (setenv "GUIX_LOCPATH"
+                             #+(file-append glibc-utf8-locales "/lib/locale"))
+                     (setlocale LC_CTYPE "en_US.utf8")
                      (delete-file-recursively "/tmp")
                      (delete-file-recursively "/var/run")
+
                      (mkdir "/tmp")
                      (chmod "/tmp" #o1777)
                      (mkdir "/var/run")
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 05c8462..d209066 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -30,6 +30,8 @@
   #:use-module (gnu services mcron)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services networking)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages bash)
   #:use-module (gnu packages imagemagick)
   #:use-module (gnu packages ocr)
   #:use-module (gnu packages package-management)
@@ -37,11 +39,13 @@
   #:use-module (gnu packages tmux)
   #:use-module (guix gexp)
   #:use-module (guix store)
+  #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (srfi srfi-1)
   #:export (run-basic-test
             %test-basic-os
             %test-halt
+            %test-cleanup
             %test-mcron
             %test-nss-mdns))
 
@@ -473,6 +477,73 @@ in a loop.  See <http://bugs.gnu.org/26931>.")
 
 
 ;;;
+;;; Cleanup of /tmp, /var/run, etc.
+;;;
+
+(define %cleanup-os
+  (simple-operating-system
+   (simple-service 'dirty-things
+                   boot-service-type
+                   (with-monad %store-monad
+                     (let ((script (plain-file
+                                    "create-utf8-file.sh"
+                                    (string-append
+                                     "echo $0: dirtying /tmp...\n"
+                                     "set -e; set -x\n"
+                                     "touch /witness\n"
+                                     "exec touch /tmp/λαμβδα"))))
+                       (with-imported-modules '((guix build utils))
+                         (return #~(begin
+                                     (setenv "PATH"
+                                             #$(file-append coreutils "/bin"))
+                                     (invoke #$(file-append bash "/bin/sh")
+                                             #$script)))))))))
+
+(define (run-cleanup-test name)
+  (define os
+    (marionette-operating-system %cleanup-os
+                                 #:imported-modules '((gnu services herd)
+                                                      (guix combinators))))
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "cleanup")
+
+          (test-assert "dirty service worked"
+            (marionette-eval '(file-exists? "/witness") marionette))
+
+          (test-equal "/tmp cleaned up"
+            '("." "..")
+            (marionette-eval '(begin
+                                (use-modules (ice-9 ftw))
+                                (scandir "/tmp"))
+                             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "cleanup" test))
+
+(define %test-cleanup
+  ;; See <https://bugs.gnu.org/26353>.
+  (system-test
+   (name "cleanup")
+   (description "Make sure the 'cleanup' service can remove files with
+non-ASCII names from /tmp.")
+   (value (run-cleanup-test name))))
+
+
+;;;
 ;;; Mcron.
 ;;;