diff mbox series

[bug#52555,v3,2/8] publish: Store ERIS encoded blocks to a local block store.

Message ID 20221229181327.758-3-pukkamustard@posteo.net
State New
Headers show
Series Decentralized substitute distribution with ERIS | expand

Commit Message

pukkamustard Dec. 29, 2022, 6:13 p.m. UTC 
* 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

Ludovic Courtès Jan. 14, 2023, 6:42 p.m. UTC | #1 
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’.
diff mbox series

Patch

diff --git a/Makefile.am b/Makefile.am
index b54288c0fc..c549fc8580 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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                       \
diff --git a/guix/eris.scm b/guix/eris.scm
new file mode 100644
index 0000000000..29d5e7b1db
--- /dev/null
+++ b/guix/eris.scm
@@ -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)))
diff --git a/guix/eris/fs-store.scm b/guix/eris/fs-store.scm
new file mode 100644
index 0000000000..2ef7607988
--- /dev/null
+++ b/guix/eris/fs-store.scm
@@ -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))))
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 76b5a429f4..7f14e4d4d4 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -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)))