summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-01-29 12:55:24 +0100
committerLudovic Courtès <ludo@gnu.org>2017-01-30 10:52:45 +0100
commit0d268c5d701423b770b05ed208461c47709dafb7 (patch)
tree9ec59a6689ff319624e799275eb1d1abc087d3c7
parent9016dbc2bb469c31915c46cf8a1baecdfe022373 (diff)
downloadpatches-0d268c5d701423b770b05ed208461c47709dafb7.tar
patches-0d268c5d701423b770b05ed208461c47709dafb7.tar.gz
store: Add 'add-data-to-store'.
* guix/serialization.scm (write-bytevector): New procedure. (write-string): Rewrite in terms of 'write-bytevector'. * guix/store.scm (write-arg): Add 'bytevector' case. (add-data-to-store): New procedure, from former 'add-text-to-store'. (add-text-to-store): Rewrite in terms of 'add-data-to-store'. * tests/store.scm ("add-data-to-store"): New test.
-rw-r--r--guix/serialization.scm12
-rw-r--r--guix/store.scm26
-rw-r--r--tests/store.scm5
3 files changed, 30 insertions, 13 deletions
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 5953b84616..4cab5910f7 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,7 +30,7 @@
#:export (write-int read-int
write-long-long read-long-long
write-padding
- write-string
+ write-bytevector write-string
read-string read-latin1-string read-maybe-utf8-string
write-string-list read-string-list
write-string-pairs
@@ -102,15 +102,17 @@
(or (zero? m)
(put-bytevector p zero 0 (- 8 m)))))))
-(define (write-string s p)
- (let* ((s (string->utf8 s))
- (l (bytevector-length s))
+(define (write-bytevector s p)
+ (let* ((l (bytevector-length s))
(m (modulo l 8))
(b (make-bytevector (+ 8 l (if (zero? m) 0 (- 8 m))))))
(bytevector-u32-set! b 0 l (endianness little))
(bytevector-copy! s 0 b 8 l)
(put-bytevector p b)))
+(define (write-string s p)
+ (write-bytevector (string->utf8 s) p))
+
(define (read-byte-string p)
(let* ((len (read-int p))
(m (modulo len 8))
diff --git a/guix/store.scm b/guix/store.scm
index cb3fbed912..cce460f3ce 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -67,6 +67,7 @@
query-path-hash
hash-part->path
query-path-info
+ add-data-to-store
add-text-to-store
add-to-store
build-things
@@ -266,12 +267,15 @@
(path-info deriver hash refs registration-time nar-size)))
(define-syntax write-arg
- (syntax-rules (integer boolean string string-list string-pairs
+ (syntax-rules (integer boolean bytevector
+ string string-list string-pairs
store-path store-path-list base16)
((_ integer arg p)
(write-int arg p))
((_ boolean arg p)
(write-int (if arg 1 0) p))
+ ((_ bytevector arg p)
+ (write-bytevector arg p))
((_ string arg p)
(write-string arg p))
((_ string-list arg p)
@@ -669,25 +673,31 @@ string). Raise an error if no such path exists."
"Return the info (hash, references, etc.) for PATH."
path-info)
-(define add-text-to-store
+(define add-data-to-store
;; A memoizing version of `add-to-store', to avoid repeated RPCs with
;; the very same arguments during a given session.
(let ((add-text-to-store
- (operation (add-text-to-store (string name) (string text)
+ (operation (add-text-to-store (string name) (bytevector text)
(string-list references))
#f
store-path)))
- (lambda* (server name text #:optional (references '()))
- "Add TEXT under file NAME in the store, and return its store path.
+ (lambda* (server name bytes #:optional (references '()))
+ "Add BYTES under file NAME in the store, and return its store path.
REFERENCES is the list of store paths referred to by the resulting store
path."
- (let ((args `(,text ,name ,references))
- (cache (nix-server-add-text-to-store-cache server)))
+ (let* ((args `(,bytes ,name ,references))
+ (cache (nix-server-add-text-to-store-cache server)))
(or (hash-ref cache args)
- (let ((path (add-text-to-store server name text references)))
+ (let ((path (add-text-to-store server name bytes references)))
(hash-set! cache args path)
path))))))
+(define* (add-text-to-store store name text #:optional (references '()))
+ "Add TEXT under file NAME in the store, and return its store path.
+REFERENCES is the list of store paths referred to by the resulting store
+path."
+ (add-data-to-store store name (string->utf8 text) references))
+
(define true
;; Define it once and for all since we use it as a default value for
;; 'add-to-store' and want to make sure two default values are 'eq?' for the
diff --git a/tests/store.scm b/tests/store.scm
index 983766d862..64d3553f25 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -92,6 +92,11 @@
(test-skip (if %store 0 13))
+(test-equal "add-data-to-store"
+ #vu8(1 2 3 4 5)
+ (call-with-input-file (add-data-to-store %store "data" #vu8(1 2 3 4 5))
+ get-bytevector-all))
+
(test-assert "valid-path? live"
(let ((p (add-text-to-store %store "hello" "hello, world")))
(valid-path? %store p)))