From 76c321d8e85683091ecbcd3afe8c56fb7c45c00a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 20 Jun 2018 10:00:44 +0200
Subject: services: cleanup: Expect file names to be UTF-8-encoded.

Fixes <https://bugs.gnu.org/26353>.
Reported by Danny Milosavljevic <dannym@scratchpost.org>.

* 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/tests/base.scm | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)

(limited to 'gnu/tests/base.scm')

diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 05c846264d..d209066a74 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))
 
@@ -471,6 +475,73 @@ in a loop.  See <http://bugs.gnu.org/26931>.")
                                     (guix combinators)))))
       (run-halt-test (virtual-machine os))))))
 
+
+;;;
+;;; 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.
-- 
cgit v1.2.3