This method allows fetching sources over GNUnet's file-sharing
system, presuming GNUnet has been configured on the local system.
- fetching substitutes over GNUnet
- fallback to legacy non-P2P servers
* guix/gnunet-download.scm, guix/build/gnunet.scm: New files.
* Makefile.am (MODULES): Add them.
* doc/guix.texi (Defining Packages): Document gnunet-fetch.
guix/build/gnunet.scm | 113 +++++++++++++++++++++++++++++++++++++++
guix/gnunet-download.scm | 89 ++++++++++++++++++++++++++++++
4 files changed, 211 insertions(+)
create mode 100644 guix/build/gnunet.scm
create mode 100644 guix/gnunet-download.scm
Toggle diff (283 lines)
diff --git a/Makefile.am b/Makefile.am
index a75d9c1ffc..f046020017 100644
@@ -94,6 +94,7 @@ MODULES = \
guix/android-repo-download.scm \
+ guix/gnunet-download.scm \
@@ -187,6 +188,7 @@ MODULES = \
guix/build/copy-build-system.scm \
+ guix/build/gnunet.scm \
guix/build/glib-or-gtk-build-system.scm \
guix/build/gnu-bootstrap.scm \
diff --git a/doc/guix.texi b/doc/guix.texi
index 8514dfe86f..8a5f0559f3 100644
@@ -81,6 +81,7 @@ Copyright @copyright{} 2020 R Veera Kumar@*
Copyright @copyright{} 2020 Pierre Langlois@*
Copyright @copyright{} 2020 pinoaffe@*
Copyright @copyright{} 2020 André Batista@*
+Copyright @copyright{} 2020 Maxime Devos@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -6595,6 +6596,12 @@ specified in the @code{uri} field as a
@code{git-reference} object; a
(url "https://git.savannah.gnu.org/git/hello.git")
+@item @var{gnunet-feth} from @code{(guix gnunet-download)}
+download a file specified by its GNUnet chk-URI. To use
+this method, the GNUnet file-sharing daemon has to be configured
+to accept connections from the loopback networking interface.
diff --git a/guix/build/gnunet.scm b/guix/build/gnunet.scm
index 0000000000..3cee161cc2
+++ b/guix/build/gnunet.scm
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2018 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
+;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2020 Maxime Devos <maxime.devos@student.kuleuven.be>
+;;; This file is part of GNU Guix.
+;;; GNU Guix is free software; you can redistribute it and/or modify
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; 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 build gnunet)
+ #:use-module (guix build utils)
+ #:use-module (srfi srfi-34)
+ #:use-module (ice-9 format)
+ #:use-module (rnrs io ports)
+ #:export (gnunet-fetch))
+;;; This is the build-side support code of (guix gnunet-download). It
+;;; files of which the GNUnet chk-URI is known to be downloaded from
+;;; file-sharing system. The code has been derived from (guix build
+;; Copied from (guix utils)
+(define (call-with-temporary-output-file proc)
+ "Call PROC with a name of a temporary file and open output port to
+file; close the file and delete it when leaving the dynamic extent of
+ (let* ((directory (or (getenv "TMPDIR") "/tmp"))
+ (template (string-append directory "/guix-file.XXXXXX"))
+ (out (mkstemp! template)))
+ (false-if-exception (close out))
+ (false-if-exception (delete-file template))))))
+(define (gnunet-fs-up? port)
+ "#t if the GNUnet FS daemon seems to be up at @var{port}, #f
+ (let ((s (socket PF_INET SOCK_STREAM 0)))
+ (connect s AF_INET INADDR_LOOPBACK port)
+ (lambda (tag function msg msg+ errno)
+ (if (and (equal? function "connect")
+ (equal? errno (list ECONNREFUSED)))
+ (throw tag function msg msg+ errno))))))
+;; TODO: gnunet directories, time-outs, perhaps use guile-gnunet
+(define* (gnunet-fetch uri file
+ #:key (gnunet-download-command "gnunet-
+ "Fetch a file identified by a GNUnet chk-URI @var{URI} into
+@var{uri} must not be a directory. Return #t on success, #f
+ (guard (c ((invoke-error? c)
+ (format (current-error-port)
+ "gnunet-fetch: '~a~{ ~a~}' failed with exit code
+ (invoke-error-program c)
+ (invoke-error-arguments c)
+ (or (invoke-error-exit-status c)
+ (invoke-error-stop-signal c)
+ (invoke-error-term-signal c)))
+ (false-if-exception (delete-file-recursively file))
+ (let ((p (getenv "gnunet port")))
+ (and p (< 0 (string-length p))
+ (let ((a (getenv "GNUNET_ANONYMITY")))
+ (cond ((equal? a "") "1")
+ ;; Check if the GNUnet daemon is up,
+ ;; otherwise gnunet-download might wait forever.
+ (if (or (not port) (gnunet-fs-up? port))
+ (call-with-temporary-output-file
+ (lambda (config-file-name config-output-port)
+ ;; Tell gnunet-download how to contact the FS daemon
+ (display (getenv "gnunet configuration") config-output-
+ (flush-output-port config-output-port)
+ (invoke gnunet-download-command uri
+ "-V" ;; print progress information
+ (format (current-error-port)
+ "gnunet-fetch: file-sharing daemon is down.~%")
+;;; gnunet.scm ends here
diff --git a/guix/gnunet-download.scm b/guix/gnunet-download.scm
index 0000000000..8a825b90ae
+++ b/guix/gnunet-download.scm
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
+;;; Copyright © 2020 Maxime Devos <maxime.devos@student.kuleuven.be>
+;;; This file is part of GNU Guix.
+;;; GNU Guix is free software; you can redistribute it and/or modify
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; 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 gnunet-download)
+ #:use-module (guix packages)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:use-module (guix gexp)
+ #:use-module (ice-9 popen)
+ #:use-module (ice-9 rdelim)
+ #:export (gnunet-fetch))
+;;; An <origin> method that uses gnunet-download to fetch a specific
+;;; the GNUnet file-sharing system. The hash is specified as a GNUnet
+;;; string. The code has been derived from (guix gx-download).
+(define (gnunet-package)
+ "Return the default GNUnet package."
+ (let ((distro (resolve-interface '(gnu packages gnunet))))
+ (module-ref distro 'gnunet)))
+(define* (gnunet-configuration #:key (gnunet (gnunet-package)))
+ "Make a configuration file allowing the build process to talk
+with the GNUnet FS daemon."
+ ;; TODO: is it acceptable to assume
+ ;; the existence of gnunet-config in PATH?
+ ;; If not, can @var{gnunet} be compiled?
+ ;; Alternatively, parse .config/gnunet.conf manually.
+ ;; TODO: by default, GNUnet uses Unix sockets
+ ;; instead of IP for IPC. Can we poke a hole
+ ;; in the build process isolation allowing this
+ (let* ((p (open-pipe* OPEN_READ "gnunet-config" "--section" "fs" "-
+ (values (format #f "[fs]~%PORT = ~a\n" port)
+(define* (gnunet-fetch uri hash-algo hash
+ #:key (system (%current-system)) (guile
+ (gnunet (gnunet-package)))
+ "Return a fixed-output derivation that fetches @var{uri}, a GNUnet
+string. The output is expected to have hash @var{hash} of type
+@var{hash-algo}. Use @var{name} as the file name, or a generic name
+ (with-imported-modules '((guix build gnunet)
+ (use-modules (guix build gnunet))
+ (or (gnunet-fetch '#$uri
+ #:gnunet-download-command
+ (string-append #+gnunet "/bin/gnunet-
+ (call-with-values (lambda () (gnunet-configuration #:gnunet
+ (lambda (configuration port)
+ `(("gnunet configuration" . ,configuration)
+ ("gnunet port" . ,port)))))
+ (mlet %store-monad ((guile (package->derivation guile system)))
+ (gexp->derivation (or name "gnunet-chk") build
+ #:local-build? #t ;; don't offload downloads
+ #:leaked-env-vars '("GNUNET_ANONYMITY")
+ #:guile-for-build guile)))
+;;; gnunet-download.scm ends here