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.

9 files changed, 231 insertions, 227 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))))))))
 
 
 ;;;
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index ea8c2ada6b..e2305d73ee 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -20,7 +20,7 @@
 (define-module (guix scripts hash)
   #:use-module (guix base32)
   #:use-module (guix hash)
-  #:use-module (guix nar)
+  #:use-module (guix serialization)
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (rnrs io ports)
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 391906ff79..5d1c7c23cb 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -21,6 +21,7 @@
   #:use-module (guix records)
   #:use-module (guix store)
   #:use-module (guix derivations)
+  #:use-module (guix serialization)
   #:use-module (guix nar)
   #:use-module (guix utils)
   #:use-module ((guix build utils) #:select (which mkdir-p))
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index a2d0cab727..f5ccc8d5e5 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -23,7 +23,7 @@
   #:use-module (guix utils)
   #:use-module (guix config)
   #:use-module (guix records)
-  #:use-module (guix nar)
+  #:use-module (guix serialization)
   #:use-module (guix hash)
   #:use-module (guix base64)
   #:use-module (guix pk-crypto)
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 284b174794..64eacf974c 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -22,7 +22,10 @@
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 ftw)
   #:export (write-int read-int
             write-long-long read-long-long
             write-padding
@@ -30,7 +33,19 @@
             write-string-list read-string-list
             write-string-pairs
             write-store-path read-store-path
-            write-store-path-list read-store-path-list))
+            write-store-path-list read-store-path-list
+
+            &nar-error
+            nar-error?
+            nar-error-port
+            nar-error-file
+
+            &nar-read-error
+            nar-read-error?
+            nar-read-error-token
+
+            write-file
+            restore-file))
 
 ;;; Comment:
 ;;;
@@ -121,4 +136,212 @@
 (define write-store-path-list write-string-list)
 (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
+
+
+(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))))))))
+
 ;;; serialization.scm ends here
diff --git a/guix/store.scm b/guix/store.scm
index 79dcf22cca..452a2f1268 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -17,7 +17,6 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix store)
-  #:use-module (guix nar)
   #:use-module (guix utils)
   #:use-module (guix config)
   #:use-module (guix serialization)
diff --git a/tests/nar.scm b/tests/nar.scm
index 3188599bf1..1641d6f9b2 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -19,6 +19,7 @@
 (define-module (test-nar)
   #:use-module (guix tests)
   #:use-module (guix nar)
+  #:use-module (guix serialization)
   #:use-module (guix store)
   #:use-module ((guix hash)
                 #:select (open-sha256-port open-sha256-input-port))
diff --git a/tests/store.scm b/tests/store.scm
index ba15524be4..88a8877d80 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -24,7 +24,7 @@
   #:use-module (guix base32)
   #:use-module (guix packages)
   #:use-module (guix derivations)
-  #:use-module (guix nar)
+  #:use-module (guix serialization)
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm
index 163cd74593..7c1204c1ab 100644
--- a/tests/substitute-binary.scm
+++ b/tests/substitute-binary.scm
@@ -21,7 +21,7 @@
   #:use-module (guix scripts substitute-binary)
   #:use-module (guix base64)
   #:use-module (guix hash)
-  #:use-module (guix nar)
+  #:use-module (guix serialization)
   #:use-module (guix pk-crypto)
   #:use-module (guix pki)
   #:use-module (guix config)