serialization: Check for EOF and incomplete input conditions.

Fixes <http://bugs.gnu.org/19756>.
Reported by <sleep_walker@suse.cz>.

* guix/serialization.scm (currently-restored-file): New variable.
  (get-bytevector-n*): New procedure.
  (read-int, read-long-long, read-string, read-latin1-string,
  read-contents): Use it instead of 'get-bytevector-n'.
  (restore-file): Parameterize 'currently-restored-file' and set it.
* tests/nar.scm ("restore-file with incomplete input"): New test.

guix/serialization.scm

@@ -56,13 +56,32 @@
 
 ;; Similar to serialize.cc in Nix.
 
+(define-condition-type &nar-error &error      ; XXX: inherit from &nix-error ?
+  nar-error?
+  (file  nar-error-file)                       ; file we were restoring, or #f
+  (port  nar-error-port))                      ; port from which we read
+
+(define currently-restored-file
+  ;; Name of the file being restored.  Used internally for error reporting.
+  (make-parameter #f))
+
+
+(define (get-bytevector-n* port count)
+  (let ((bv (get-bytevector-n port count)))
+    (when (or (eof-object? bv)
+              (< (bytevector-length bv) count))
+      (raise (condition (&nar-error
+                         (file (currently-restored-file))
+                         (port port)))))
+    bv))
+
 (define (write-int n p)
   (let ((b (make-bytevector 8 0)))
     (bytevector-u32-set! b 0 n (endianness little))
     (put-bytevector p b)))
 
 (define (read-int p)
-  (let ((b (get-bytevector-n p 8)))
+  (let ((b (get-bytevector-n* p 8)))
     (bytevector-u32-ref b 0 (endianness little))))
 
 (define (write-long-long n p)
@@ -71,7 +90,7 @@
     (put-bytevector p b)))
 
 (define (read-long-long p)
-  (let ((b (get-bytevector-n p 8)))
+  (let ((b (get-bytevector-n* p 8)))
     (bytevector-u64-ref b 0 (endianness little))))
 
 (define write-padding
@@ -93,10 +112,10 @@
 (define (read-string p)
   (let* ((len (read-int p))
          (m   (modulo len 8))
-         (bv  (get-bytevector-n p len))
+         (bv  (get-bytevector-n* p len))
          (str (utf8->string bv)))
     (or (zero? m)
-        (get-bytevector-n p (- 8 m)))
+        (get-bytevector-n* p (- 8 m)))
     str))
 
 (define (read-latin1-string p)
@@ -105,9 +124,9 @@
          ;; Note: do not use 'get-string-n' to work around Guile bug
          ;; <http://bugs.gnu.org/19621>.  See <http://bugs.gnu.org/19610> for
          ;; a discussion.
-         (str (get-bytevector-n p len)))
+         (str (get-bytevector-n* p len)))
     (or (zero? m)
-        (get-bytevector-n p (- 8 m)))
+        (get-bytevector-n* p (- 8 m)))
 
     ;; XXX: Rewrite using (ice-9 iconv) when the minimum requirement is
     ;; upgraded to Guile >= 2.0.9.
@@ -143,11 +162,6 @@
 (define read-store-path-list read-string-list)
 
 
-(define-condition-type &nar-error &error      ; XXX: inherit from &nix-error ?
-  nar-error?
-  (file  nar-error-file)                       ; file we were restoring, or #f
-  (port  nar-error-port))                      ; port from which we read
-
 (define-condition-type &nar-read-error &nar-error
   nar-read-error?
   (token nar-read-error-token))                 ; faulty token, or #f
@@ -222,7 +236,7 @@ the size in bytes."
       (chmod out #o755))
     (let ((m (modulo size 8)))
       (unless (zero? m)
-        (get-bytevector-n in (- 8 m))))
+        (get-bytevector-n* in (- 8 m))))
     size))
 
 (define %archive-version-1
@@ -286,6 +300,7 @@ sub-directories of FILE as needed."
 (define (restore-file port file)
   "Read a file (possibly a directory structure) in Nar format from PORT.
 Restore it as FILE."
+  (parameterize ((currently-restored-file file))
     (let ((signature (read-string port)))
       (unless (equal? signature %archive-version-1)
         (raise
@@ -303,6 +318,8 @@ Restore it as FILE."
                (&message (message "invalid nar end-of-file marker"))
                (&nar-read-error (port port) (file file) (token x)))))))
 
+      (currently-restored-file file)
+
       (match (list (read-string port) (read-string port) (read-string port))
         (("(" "type" "regular")
          (call-with-output-file file (cut read-contents port <>))
@@ -348,6 +365,6 @@ Restore it as FILE."
          (raise
           (condition
            (&message (message "unsupported nar entry type"))
-         (&nar-read-error (port port) (file file) (token x))))))))
+           (&nar-read-error (port port) (file file) (token x)))))))))
 
 ;;; serialization.scm ends here

tests/nar.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -201,6 +201,15 @@
       (lambda ()
         (rm-rf input)))))
 
+(test-equal "restore-file with incomplete input"
+  (string-append %test-dir "/foo")
+  (let ((port (open-bytevector-input-port #vu8(1 2 3))))
+    (guard (c ((nar-error? c)
+               (and (eq? port (nar-error-port c))
+                    (nar-error-file c))))
+      (restore-file port (string-append %test-dir "/foo"))
+      #f)))
+
 (test-assert "write-file + restore-file"
   (let* ((input  (string-append (dirname (search-path %load-path "guix.scm"))
                                 "/guix"))