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:
parent
661c237b4d
commit
76c321d8e8
|
@ -394,8 +394,14 @@ boot."
|
||||||
(delete-file "/etc/passwd.lock")
|
(delete-file "/etc/passwd.lock")
|
||||||
(delete-file "/etc/.pwd.lock") ;from 'lckpwdf'
|
(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 "/tmp")
|
||||||
(delete-file-recursively "/var/run")
|
(delete-file-recursively "/var/run")
|
||||||
|
|
||||||
(mkdir "/tmp")
|
(mkdir "/tmp")
|
||||||
(chmod "/tmp" #o1777)
|
(chmod "/tmp" #o1777)
|
||||||
(mkdir "/var/run")
|
(mkdir "/var/run")
|
||||||
|
|
|
@ -30,6 +30,8 @@
|
||||||
#:use-module (gnu services mcron)
|
#:use-module (gnu services mcron)
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
#:use-module (gnu services networking)
|
#:use-module (gnu services networking)
|
||||||
|
#:use-module (gnu packages base)
|
||||||
|
#:use-module (gnu packages bash)
|
||||||
#:use-module (gnu packages imagemagick)
|
#:use-module (gnu packages imagemagick)
|
||||||
#:use-module (gnu packages ocr)
|
#:use-module (gnu packages ocr)
|
||||||
#:use-module (gnu packages package-management)
|
#:use-module (gnu packages package-management)
|
||||||
|
@ -37,11 +39,13 @@
|
||||||
#:use-module (gnu packages tmux)
|
#:use-module (gnu packages tmux)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
|
#:use-module (guix monads)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:export (run-basic-test
|
#:export (run-basic-test
|
||||||
%test-basic-os
|
%test-basic-os
|
||||||
%test-halt
|
%test-halt
|
||||||
|
%test-cleanup
|
||||||
%test-mcron
|
%test-mcron
|
||||||
%test-nss-mdns))
|
%test-nss-mdns))
|
||||||
|
|
||||||
|
@ -471,6 +475,73 @@ in a loop. See <http://bugs.gnu.org/26931>.")
|
||||||
(guix combinators)))))
|
(guix combinators)))))
|
||||||
(run-halt-test (virtual-machine os))))))
|
(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.
|
;;; Mcron.
|
||||||
|
|
Loading…
Reference in New Issue