summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-18 14:23:31 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-18 17:51:34 +0100
commit9fe3f11398e858f1d06120bd046cab506efc86dc (patch)
tree24aac8e3ba08e420b60cc66fe008aaa355e4e200
parent7bf1dc75706d558cea41e24ce90f2eb0c026996d (diff)
serialization: 'restore-file' errors out upon non-convertible file names.
Fixes <https://bugs.gnu.org/33603>. Reported by Maxim Cournoyer <maxim.cournoyer@gmail.com>. * guix/serialization.scm (port-conversion-strategy): New variable. (restore-file): Parameterize it. * tests/nar.scm ("restore-file with non-UTF8 locale"): New test.
-rw-r--r--guix/serialization.scm13
-rw-r--r--tests/nar.scm36
2 files changed, 46 insertions, 3 deletions
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 87ad7eeec01..7c0fea552d5 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -380,10 +380,19 @@ which case you can use 'identity'."
380 (&nar-error (file f) (port port)))))) 380 (&nar-error (file f) (port port))))))
381 (write-string ")" p))) 381 (write-string ")" p)))
382 382
383(define port-conversion-strategy
384 (fluid->parameter %default-port-conversion-strategy))
385
383(define (restore-file port file) 386(define (restore-file port file)
384 "Read a file (possibly a directory structure) in Nar format from PORT. 387 "Read a file (possibly a directory structure) in Nar format from PORT.
385Restore it as FILE." 388Restore it as FILE."
386 (parameterize ((currently-restored-file file)) 389 (parameterize ((currently-restored-file file)
390
391 ;; Error out if we can convert file names to the current
392 ;; locale. (XXX: We'd prefer UTF-8 encoding for file names
393 ;; regardless of the locale, but that's what Guile gives us
394 ;; so far.)
395 (port-conversion-strategy 'error))
387 (let ((signature (read-string port))) 396 (let ((signature (read-string port)))
388 (unless (equal? signature %archive-version-1) 397 (unless (equal? signature %archive-version-1)
389 (raise 398 (raise
diff --git a/tests/nar.scm b/tests/nar.scm
index 5ffe68c9e2b..bfc71c69a8e 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -334,6 +334,40 @@
334 (lambda () 334 (lambda ()
335 (rmdir input))))) 335 (rmdir input)))))
336 336
337(test-eq "restore-file with non-UTF8 locale" ;<https://bugs.gnu.org/33603>
338 'encoding-error
339 (let* ((file (search-path %load-path "guix.scm"))
340 (output (string-append %test-dir "/output"))
341 (locale (setlocale LC_ALL "C")))
342 (dynamic-wind
343 (lambda () #t)
344 (lambda ()
345 (define-values (port get-bytevector)
346 (open-bytevector-output-port))
347
348 (write-file-tree "root" port
349 #:file-type+size
350 (match-lambda
351 ("root" (values 'directory 0))
352 ("root/λ" (values 'regular 0)))
353 #:file-port (const (%make-void-port "r"))
354 #:symlink-target (const #f)
355 #:directory-entries (const '("λ")))
356 (close-port port)
357
358 (mkdir %test-dir)
359 (catch 'encoding-error
360 (lambda ()
361 ;; This show throw to 'encoding-error.
362 (restore-file (open-bytevector-input-port (get-bytevector))
363 output)
364 (scandir output))
365 (lambda args
366 'encoding-error)))
367 (lambda ()
368 (false-if-exception (rm-rf %test-dir))
369 (setlocale LC_ALL locale)))))
370
337(test-assert "restore-file-set (signed, valid)" 371(test-assert "restore-file-set (signed, valid)"
338 (with-store store 372 (with-store store
339 (let* ((texts (unfold (cut >= <> 10) 373 (let* ((texts (unfold (cut >= <> 10)