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.
This commit is contained in:
Ludovic Courtès 2018-06-20 10:00:44 +02:00
parent 661c237b4d
commit 76c321d8e8
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 77 additions and 0 deletions

@ -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")

@ -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.