3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

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.
This commit is contained in:
Ludovic Courtès 2017-01-29 12:55:24 +01:00
parent 9016dbc2bb
commit 0d268c5d70
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 30 additions and 13 deletions

View file

@ -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))

View file

@ -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

View file

@ -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)))