[bug#52555,v3,2/8] publish: Store ERIS encoded blocks to a local block store.
Commit Message
* guix/eris.scm: New file.
* guix/eris/fs-store.scm: New file.
* Makefile.am (MODULES): Add new files.
* guix/scripts/publish.scm (bake-narinfo+nar): Use guix-eris-block-reducer.
---
Makefile.am | 2 ++
guix/eris.scm | 36 +++++++++++++++++++++
guix/eris/fs-store.scm | 67 ++++++++++++++++++++++++++++++++++++++++
guix/scripts/publish.scm | 14 +++++----
4 files changed, 113 insertions(+), 6 deletions(-)
create mode 100644 guix/eris.scm
create mode 100644 guix/eris/fs-store.scm
Comments
pukkamustard <pukkamustard@posteo.net> skribis:
> * guix/eris.scm: New file.
> * guix/eris/fs-store.scm: New file.
> * Makefile.am (MODULES): Add new files.
> * guix/scripts/publish.scm (bake-narinfo+nar): Use guix-eris-block-reducer.
[...]
> +(define %eris-block-store-directory
> + (make-parameter
> + (or (getenv "GUIX_ERIS_BLOCK_STORE_DIRECTORY")
> + (string-append %state-directory "/eris"))))
> +
> +(define (guix-eris-block-reducer)
> + "Returns a block reducer that stores blocks of ERIS encoded content."
> + (eris-fs-store-reducer (%eris-block-store-directory)))
Maybe this should be private to (guix scripts publish)?
Also, the store directory should be /var/cache/guix/publish/eris by
default IMO.
> +(define (eris-fs-store-reducer store-directory)
> + (case-lambda
> + (() (mkdir-p store-directory))
> +
> + ((result) result)
> +
> + ((_ ref-block)
> + (let* ((ref (car ref-block))
> + (b32 (base32-encode ref))
> + (pre (substring b32 0 2))
> + (suf (substring b32 2))
> + (pre-dir (string-append store-directory "/" pre))
> + (path (string-append pre-dir "/" suf))
> + (block (cdr ref-block)))
> +
> + (mkdir-p pre-dir)
> +
> + (unless (file-exists? path)
> + (call-with-output-file path
> + (lambda (port) (put-bytevector port block))
> + #:binary #t))
> +
> + #t))))
> +
> +(define (eris-fs-store-ref store-directory)
> + (lambda (ref)
> + (let* ((b32 (base32-encode ref))
> + (pre (substring b32 0 2))
> + (suf (substring b32 2))
> + (path (string-append store-directory "/" pre "/" suf)))
> + (if (file-exists? path)
> + (call-with-input-file path
> + (lambda (port) (get-bytevector-all port))
> + #:binary #t)
> + #f))))
Could you add docstrings, remove tabs, and use (ice-9 match) instead of
car/cdr? :-)
Whole files (blocks, right?) get loaded in memory. Is that OK or should
it be avoided?
There are time-of-check-to-time-of-use race conditions with those
‘file-exists?’ calls. In the case of ‘ref’, you can instead write:
(catch 'system-error
(lambda ()
(call-with-input-file …))
(lambda args
(if (= ENOENT (system-error-errno args))
#f
(apply throw args))))
In the case of ‘reducer’, perhaps it’d be safer to write the block
atomically with ‘with-atomic-file-output’? (And remove the
‘file-exists?’ check too?)
Write “file” rather than “path” (the latter is used to refer to “search
paths”). :-)
Ludo’.
@@ -132,6 +132,8 @@ MODULES = \
guix/least-authority.scm \
guix/read-print.scm \
guix/ipfs.scm \
+ guix/eris.scm \
+ guix/eris/fs-store.scm \
guix/platform.scm \
guix/platforms/arm.scm \
guix/platforms/mips.scm \
new file mode 100644
@@ -0,0 +1,36 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 pukkamustard <pukkamustard@posteo.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix eris)
+ #:use-module (eris)
+
+ #:use-module (guix config)
+ #:use-module (guix eris fs-store)
+
+ #:export (guix-eris-block-reducer
+
+ %eris-block-store-directory))
+
+(define %eris-block-store-directory
+ (make-parameter
+ (or (getenv "GUIX_ERIS_BLOCK_STORE_DIRECTORY")
+ (string-append %state-directory "/eris"))))
+
+(define (guix-eris-block-reducer)
+ "Returns a block reducer that stores blocks of ERIS encoded content."
+ (eris-fs-store-reducer (%eris-block-store-directory)))
new file mode 100644
@@ -0,0 +1,67 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 pukkamustard <pukkamustard@posteo.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix eris fs-store)
+ #:use-module (rnrs io ports)
+ #:use-module (guix build utils) ; for mkdir-p
+ #:use-module (eris utils base32)
+
+ #:export (eris-fs-store-reducer
+ eris-fs-store-ref))
+
+;;; Commentary:
+;;;
+;;; This module provides a file-system based store of ERIS encoded blocks.
+;;;
+;;; Code:
+
+(define (eris-fs-store-reducer store-directory)
+ (case-lambda
+ (() (mkdir-p store-directory))
+
+ ((result) result)
+
+ ((_ ref-block)
+ (let* ((ref (car ref-block))
+ (b32 (base32-encode ref))
+ (pre (substring b32 0 2))
+ (suf (substring b32 2))
+ (pre-dir (string-append store-directory "/" pre))
+ (path (string-append pre-dir "/" suf))
+ (block (cdr ref-block)))
+
+ (mkdir-p pre-dir)
+
+ (unless (file-exists? path)
+ (call-with-output-file path
+ (lambda (port) (put-bytevector port block))
+ #:binary #t))
+
+ #t))))
+
+(define (eris-fs-store-ref store-directory)
+ (lambda (ref)
+ (let* ((b32 (base32-encode ref))
+ (pre (substring b32 0 2))
+ (suf (substring b32 2))
+ (path (string-append store-directory "/" pre "/" suf)))
+ (if (file-exists? path)
+ (call-with-input-file path
+ (lambda (port) (get-bytevector-all port))
+ #:binary #t)
+ #f))))
@@ -52,6 +52,7 @@ (define-module (guix scripts publish)
#:use-module (guix base64)
#:use-module (guix config)
#:use-module (guix derivations)
+ #:use-module (guix eris)
#:use-module (gcrypt hash)
#:use-module (guix pki)
#:use-module (gcrypt pk-crypto)
@@ -647,12 +648,13 @@ (define (eris-encode-nar compressions)
(and stat
(call-with-input-file nar
(lambda (port)
- (let ((eris-urn _
- (eris-encode port
- #:block-size 'large
- #:block-reducer rcount
- #:convergence-secret
- %null-convergence-secret)))
+ (let ((eris-urn
+ _ (eris-encode port
+ #:block-size 'large
+ #:block-reducer
+ (guix-eris-block-reducer)
+ #:convergence-secret
+ %null-convergence-secret)))
eris-urn)))))))
(let ((compression (actual-compressions item compressions)))