From 0363991a250177912d4ee6849c1b5ba05fbeaaff Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 9 Oct 2014 23:46:13 +0200 Subject: 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. --- guix/nar.scm | 222 +---------------------------------------------------------- 1 file changed, 1 insertion(+), 221 deletions(-) (limited to 'guix/nar.scm') 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)) - (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)))))))) ;;; -- cgit v1.2.3