me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2014-10-09 23:46:13 +02:00
parent 4938b0eead
commit 0363991a25
9 changed files with 231 additions and 227 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

222
guix/nar.scm
View File

@ -27,32 +27,18 @@
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix pki) #:use-module (guix pki)
#:use-module (guix pk-crypto) #:use-module (guix pk-crypto)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module (ice-9 ftw) #:export (nar-invalid-hash-error?
#: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?
nar-invalid-hash-error-expected nar-invalid-hash-error-expected
nar-invalid-hash-error-actual nar-invalid-hash-error-actual
nar-signature-error? nar-signature-error?
nar-signature-error-signature nar-signature-error-signature
write-file
restore-file
restore-file-set)) restore-file-set))
;;; Comment: ;;; Comment:
@ -61,15 +47,6 @@
;;; ;;;
;;; Code: ;;; 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 (define-condition-type &nar-signature-error &nar-error
nar-signature-error? nar-signature-error?
(signature nar-signature-error-signature)) ; faulty signature or #f (signature nar-signature-error-signature)) ; faulty signature or #f
@ -79,203 +56,6 @@
(expected nar-invalid-hash-error-expected) ; expected hash (a bytevector) (expected nar-invalid-hash-error-expected) ; expected hash (a bytevector)
(actual nar-invalid-hash-error-actual)) ; actual hash (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))))))))
;;; ;;;

2
guix/scripts/hash.scm
View File

@ -20,7 +20,7 @@
(define-module (guix scripts hash) (define-module (guix scripts hash)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix nar) #:use-module (guix serialization)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)

1
guix/scripts/offload.scm
View File

@ -21,6 +21,7 @@
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix serialization)
#:use-module (guix nar) #:use-module (guix nar)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix build utils) #:select (which mkdir-p)) #:use-module ((guix build utils) #:select (which mkdir-p))

2
guix/scripts/substitute-binary.scm
View File

@ -23,7 +23,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix nar) #:use-module (guix serialization)
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix base64) #:use-module (guix base64)
#:use-module (guix pk-crypto) #:use-module (guix pk-crypto)

225
guix/serialization.scm
View File

@ -22,7 +22,10 @@
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:export (write-int read-int #:export (write-int read-int
write-long-long read-long-long write-long-long read-long-long
write-padding write-padding
@ -30,7 +33,19 @@
write-string-list read-string-list write-string-list read-string-list
write-string-pairs write-string-pairs
write-store-path read-store-path 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: ;;; Comment:
;;; ;;;
@ -121,4 +136,212 @@
(define write-store-path-list write-string-list) (define write-store-path-list write-string-list)
(define read-store-path-list read-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 ;;; serialization.scm ends here

1
guix/store.scm
View File

@ -17,7 +17,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix store) (define-module (guix store)
#:use-module (guix nar)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix serialization) #:use-module (guix serialization)

1
tests/nar.scm
View File

@ -19,6 +19,7 @@
(define-module (test-nar) (define-module (test-nar)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module (guix nar) #:use-module (guix nar)
#:use-module (guix serialization)
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix hash) #:use-module ((guix hash)
#:select (open-sha256-port open-sha256-input-port)) #:select (open-sha256-port open-sha256-input-port))

2
tests/store.scm
View File

@ -24,7 +24,7 @@
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix nar) #:use-module (guix serialization)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module (ice-9 match) #:use-module (ice-9 match)

2
tests/substitute-binary.scm
View File

@ -21,7 +21,7 @@
#:use-module (guix scripts substitute-binary) #:use-module (guix scripts substitute-binary)
#:use-module (guix base64) #:use-module (guix base64)
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix nar) #:use-module (guix serialization)
#:use-module (guix pk-crypto) #:use-module (guix pk-crypto)
#:use-module (guix pki) #:use-module (guix pki)
#:use-module (guix config) #:use-module (guix config)