Break module cycle involving (guix store) and (guix ui).

Before, there was a cycle along the lines of:

  (guix store) -> (guix nar) -> (guix ui) -> (guix store)

This caused problems, as discussed at:

  http://lists.gnu.org/archive/html/guix-devel/2014-10/msg00109.html

This patch removes cycles in the (guix ...) modules.

* guix/nar.scm (&nar-error, &nar-read-error, dump, write-contents,
  read-contents, %archive-version-1, write-file, restore-file): Move to...
* guix/serialization.scm: ... here.
* guix/store.scm: Remove dependency on (guix nar).
* guix/scripts/hash.scm, guix/scripts/offload.scm,
  guix/scripts/substitute-binary.scm, tests/nar.scm, tests/store.scm,
  tests/substitute-binary.scm: Adjust accordingly.

1 files changed, 1 insertions, 221 deletions

diff --git a/guix/nar.scm b/guix/nar.scm
index b95cbd648d..bab727e65d 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -27,32 +27,18 @@
   #:use-module (guix hash)
   #:use-module (guix pki)
   #:use-module (guix pk-crypto)
-  #:use-module (rnrs bytevectors)
-  #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
-  #:use-module (ice-9 ftw)
-  #:use-module (ice-9 match)
-  #:export (nar-error?
-            nar-error-port
-            nar-error-file
-
-            nar-read-error?
-            nar-read-error-token
-
-            nar-invalid-hash-error?
+  #:export (nar-invalid-hash-error?
             nar-invalid-hash-error-expected
             nar-invalid-hash-error-actual
 
             nar-signature-error?
             nar-signature-error-signature
 
-            write-file
-            restore-file
-
             restore-file-set))
 
 ;;; Comment:
@@ -61,15 +47,6 @@
 ;;;
 ;;; Code:
 
-(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
-
 (define-condition-type &nar-signature-error &nar-error
   nar-signature-error?
   (signature nar-signature-error-signature))      ; faulty signature or #f
@@ -79,203 +56,6 @@
   (expected  nar-invalid-hash-error-expected)     ; expected hash (a bytevector)
   (actual    nar-invalid-hash-error-actual))      ; actual hash
 
-
-(define (dump in out size)
-  "Copy SIZE bytes from IN to OUT."
-  (define buf-size 65536)
-  (define buf (make-bytevector buf-size))
-
-  (let loop ((left size))
-    (if (<= left 0)
-        0
-        (let ((read (get-bytevector-n! in buf 0 (min left buf-size))))
-          (if (eof-object? read)
-              left
-              (begin
-                (put-bytevector out buf 0 read)
-                (loop (- left read))))))))
-
-(define (write-contents file p size)
-  "Write SIZE bytes from FILE to output port P."
-  (define (call-with-binary-input-file file proc)
-    ;; Open FILE as a binary file.  This avoids scan-for-encoding, and thus
-    ;; avoids any initial buffering.  Disable file name canonicalization to
-    ;; avoid stat'ing like crazy.
-    (with-fluids ((%file-port-name-canonicalization #f))
-      (let ((port (open-file file "rb")))
-        (dynamic-wind
-          (const #t)
-          (cut proc port)
-          (lambda ()
-            (close-port port))))))
-
-  (write-string "contents" p)
-  (write-long-long size p)
-  (call-with-binary-input-file file
-    ;; Use `sendfile' when available (Guile 2.0.8+).
-    (if (and (compile-time-value (defined? 'sendfile))
-             (file-port? p))
-        (cut sendfile p <> size 0)
-        (cut dump <> p size)))
-  (write-padding size p))
-
-(define (read-contents in out)
-  "Read the contents of a file from the Nar at IN, write it to OUT, and return
-the size in bytes."
-  (define executable?
-    (match (read-string in)
-      ("contents"
-       #f)
-      ("executable"
-       (match (list (read-string in) (read-string in))
-         (("" "contents") #t)
-         (x (raise
-             (condition (&message
-                         (message "unexpected executable file marker"))
-                        (&nar-read-error (port in)
-                                         (file #f)
-                                         (token x))))))
-       #t)
-      (x
-       (raise
-        (condition (&message (message "unsupported nar file type"))
-                   (&nar-read-error (port in) (file #f) (token x)))))))
-
-  (let ((size (read-long-long in)))
-    ;; Note: `sendfile' cannot be used here because of port buffering on IN.
-    (dump in out size)
-
-    (when executable?
-      (chmod out #o755))
-    (let ((m (modulo size 8)))
-      (unless (zero? m)
-        (get-bytevector-n in (- 8 m))))
-    size))
-
-(define %archive-version-1
-  ;; Magic cookie for Nix archives.
-  "nix-archive-1")
-
-(define (write-file file port)
-  "Write the contents of FILE to PORT in Nar format, recursing into
-sub-directories of FILE as needed."
-  (define p port)
-
-  (write-string %archive-version-1 p)
-
-  (let dump ((f file))
-    (let ((s (lstat f)))
-      (write-string "(" p)
-      (case (stat:type s)
-        ((regular)
-         (write-string "type" p)
-         (write-string "regular" p)
-         (if (not (zero? (logand (stat:mode s) #o100)))
-             (begin
-               (write-string "executable" p)
-               (write-string "" p)))
-         (write-contents f p (stat:size s)))
-        ((directory)
-         (write-string "type" p)
-         (write-string "directory" p)
-         (let ((entries
-                ;; NOTE: Guile 2.0.5's 'scandir' returns all subdirectories
-                ;; unconditionally, including "." and "..", regardless of the
-                ;; 'select?' predicate passed to it, so we have to filter
-                ;; those out externally.
-                (filter (negate (cut member <> '("." "..")))
-                        ;; 'scandir' defaults to 'string-locale<?' to sort
-                        ;; files, but this happens to be case-insensitive (at
-                        ;; least in 'en_US' locale on libc 2.18.)  Conversely,
-                        ;; we want files to be sorted in a case-sensitive
-                        ;; fashion.
-                        (scandir f (const #t) string<?))))
-           (for-each (lambda (e)
-                       (let ((f (string-append f "/" e)))
-                         (write-string "entry" p)
-                         (write-string "(" p)
-                         (write-string "name" p)
-                         (write-string e p)
-                         (write-string "node" p)
-                         (dump f)
-                         (write-string ")" p)))
-                     entries)))
-        ((symlink)
-         (write-string "type" p)
-         (write-string "symlink" p)
-         (write-string "target" p)
-         (write-string (readlink f) p))
-        (else
-         (raise (condition (&message (message "unsupported file type"))
-                           (&nar-error (file f) (port port))))))
-      (write-string ")" p))))
-
-(define (restore-file port file)
-  "Read a file (possibly a directory structure) in Nar format from PORT.
-Restore it as FILE."
-  (let ((signature (read-string port)))
-    (unless (equal? signature %archive-version-1)
-      (raise
-       (condition (&message (message "invalid nar signature"))
-                  (&nar-read-error (port port)
-                                   (token signature)
-                                   (file #f))))))
-
-  (let restore ((file file))
-    (define (read-eof-marker)
-      (match (read-string port)
-        (")" #t)
-        (x (raise
-            (condition
-             (&message (message "invalid nar end-of-file marker"))
-             (&nar-read-error (port port) (file file) (token x)))))))
-
-    (match (list (read-string port) (read-string port) (read-string port))
-      (("(" "type" "regular")
-       (call-with-output-file file (cut read-contents port <>))
-       (read-eof-marker))
-      (("(" "type" "symlink")
-       (match (list (read-string port) (read-string port))
-         (("target" target)
-          (symlink target file)
-          (read-eof-marker))
-         (x (raise
-             (condition
-              (&message (message "invalid symlink tokens"))
-              (&nar-read-error (port port) (file file) (token x)))))))
-      (("(" "type" "directory")
-       (let ((dir file))
-         (mkdir dir)
-         (let loop ((prefix (read-string port)))
-           (match prefix
-             ("entry"
-              (match (list (read-string port)
-                           (read-string port) (read-string port)
-                           (read-string port))
-                (("(" "name" file "node")
-                 (restore (string-append dir "/" file))
-                 (match (read-string port)
-                   (")" #t)
-                   (x
-                    (raise
-                     (condition
-                      (&message
-                       (message "unexpected directory entry termination"))
-                      (&nar-read-error (port port)
-                                       (file file)
-                                       (token x))))))
-                 (loop (read-string port)))))
-             (")" #t)                             ; done with DIR
-             (x
-              (raise
-               (condition
-                (&message (message "unexpected directory inter-entry marker"))
-                (&nar-read-error (port port) (file file) (token x)))))))))
-      (x
-       (raise
-        (condition
-         (&message (message "unsupported nar entry type"))
-         (&nar-read-error (port port) (file file) (token x))))))))
 
 
 ;;;