Package: guix-patches;
Reported by: pukkamustard <pukkamustard <at> posteo.net>
Date: Thu, 16 Dec 2021 16:18:02 UTC
Severity: important
Tags: patch
Message #148 received at 52555 <at> debbugs.gnu.org (full text, mbox):
From: pukkamustard <pukkamustard <at> posteo.net> To: 52555 <at> debbugs.gnu.org Cc: pukkamustard <pukkamustard <at> posteo.net> Subject: [PATCH v3 2/8] publish: Store ERIS encoded blocks to a local block store. Date: Thu, 29 Dec 2022 18:13:21 +0000
* 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
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 <at> 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 <at> 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)))
--
2.38.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.