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.master
parent
661c237b4d
commit
76c321d8e8
|
@ -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.
|
||||
|
|
Reference in New Issue