From mboxrd@z Thu Jan 1 00:00:00 1970 From: ludo@gnu.org (Ludovic =?UTF-8?Q?Court=C3=A8s?=) Subject: bug#26353: GuixSD /tmp cleaner fails to clean when Umlauts like "=?UTF-8?Q?=C3=A4?=" are used in filenames Date: Fri, 15 Dec 2017 11:27:49 +0100 Message-ID: <87d13gl1zu.fsf@gnu.org> References: <20170403202146.2a9317ce@scratchpost.org> <87poghdbge.fsf@gnu.org> <87mvb8f2a7.fsf@gnu.org> <20170423040301.53ea208f@scratchpost.org> <87fugo1efp.fsf@gnu.org> <20171214232857.131aa0d6@scratchpost.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:36168) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ePnDu-0000Po-HE for bug-guix@gnu.org; Fri, 15 Dec 2017 05:28:12 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ePnDn-0001K2-1n for bug-guix@gnu.org; Fri, 15 Dec 2017 05:28:06 -0500 Received: from debbugs.gnu.org ([208.118.235.43]:54230) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ePnDm-0001Ju-Sj for bug-guix@gnu.org; Fri, 15 Dec 2017 05:28:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ePnDm-0004Nn-HB for bug-guix@gnu.org; Fri, 15 Dec 2017 05:28:02 -0500 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <20171214232857.131aa0d6@scratchpost.org> (Danny Milosavljevic's message of "Thu, 14 Dec 2017 23:28:57 +0100") List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: Danny Milosavljevic Cc: 26353@debbugs.gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Danny Milosavljevic skribis: >> The problem of how to deal with file name encoding has been discussed on >> the Guile side so hopefully the next release in the 2.2 series will have >> a solution for this. > > Hmm, any news on this? I've again got some immortal files in /tmp ... I=E2=80=99m afraid no. Months ago a solution was proposed on the Guile sid= e but not implemented. I tried the attached workaround, which attempts to use are UTF-8-only syscalls wrappers for the task. Unfortunately it doesn=E2=80=99t work beca= use the cleanup code runs on the initrd=E2=80=99s statically-linked Guile, where =E2=80=98dynamic-link=E2=80=99 calls used in (guix build syscalls) fail. := -/ Ideas? Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable diff --git a/gnu/services.scm b/gnu/services.scm index 016ff08e0..7d9fd132f 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -361,9 +361,12 @@ directory." "Return as a monadic value a gexp to clean up /tmp and similar places up= on boot." (with-monad %store-monad - (with-imported-modules '((guix build utils)) + (with-imported-modules (source-module-closure + '((guix build utils) + (guix build syscalls))) (return #~(begin - (use-modules (guix build utils)) + (use-modules (guix build utils) + (guix build syscalls)) =20 ;; Clean out /tmp and /var/run. ;; @@ -387,8 +390,12 @@ boot." (delete-file "/etc/passwd.lock") (delete-file "/etc/.pwd.lock") ;from 'lckpwdf' =20 - (delete-file-recursively "/tmp") - (delete-file-recursively "/var/run") + ;; Assume file names are UTF-8 encoded. See + ;; . + (with-utf8-file-names + (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 1bc7a7027..3cec5af7f 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -29,6 +29,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) @@ -36,11 +38,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)) =20 @@ -476,6 +480,67 @@ in a loop. See .") (run-halt-test (virtual-machine os)))))) =20 +;;; +;;; 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" + "exec touch /tmp/{=CE=BB=CE=B1=CE=BC= =CE=B2=CE=B4=CE=B1,witness}"))) + (with-imported-modules '((guix build utils)) + (return #~(begin + (setenv "PATH" + #$(file-append coreutils "/bi= n")) + (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" + 2 + (marionette-eval '(stat:nlink (stat "/tmp")) marionette)) + + (test-end) + (exit (=3D (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "cleanup" test)) + +(define %test-cleanup + ;; See . + (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. ;;; diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 0cb630cfb..ac27fb5d6 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -71,6 +71,7 @@ fdatasync pivot-root scandir* + with-utf8-file-names fcntl-flock =20 set-thread-name @@ -995,6 +996,35 @@ system to PUT-OLD." (lambda () (closedir* directory))))) =20 +(define delete-file* + (let ((proc (syscall->procedure int "unlike" '(*)))) + (lambda* (file #:optional (string->pointer string->pointer/utf-8)) + (proc (string->pointer file))))) + +(define* (call-with-utf8-file-names thunk) + (let ((real-delete-file delete-file) + (real-opendir opendir) + (real-readdir readdir)) + (dynamic-wind + (lambda () + (set! delete-file delete-file*) + (set! opendir opendir*) + (set! readdir readdir*)) + thunk + (lambda () + (set! delete-file real-delete-file) + (set! opendir real-opendir) + (set! readdir real-readdir))))) + +(define-syntax-rule (with-utf8-file-names body ...) + "Evaluate BODY in a context where *some* of the core file system bindings +have been replaced with variants that assume file names are UTF-8-encoded +instead of locale-encoded. + +This hack is meant to address . Use with care, +and only in a single-threaded context!" + (call-with-utf8-file-names (lambda () body ...))) + ;;; ;;; Advisory file locking. --=-=-=--