M guix/nar.scm => guix/nar.scm +1 -221
@@ 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))))))))
;;;
M guix/scripts/hash.scm => guix/scripts/hash.scm +1 -1
@@ 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)
M guix/scripts/offload.scm => guix/scripts/offload.scm +1 -0
@@ 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))
M guix/scripts/substitute-binary.scm => guix/scripts/substitute-binary.scm +1 -1
@@ 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)
M guix/serialization.scm => guix/serialization.scm +224 -1
@@ 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
M guix/store.scm => guix/store.scm +0 -1
@@ 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)
M tests/nar.scm => tests/nar.scm +1 -0
@@ 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))
M tests/store.scm => tests/store.scm +1 -1
@@ 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)
M tests/substitute-binary.scm => tests/substitute-binary.scm +1 -1
@@ 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)