Toggle diff (283 lines)
diff --git a/Makefile.am b/Makefile.am
index a75d9c1ffc..f046020017 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -94,6 +94,7 @@ MODULES = \
guix/android-repo-download.scm \
guix/bzr-download.scm \
guix/git-download.scm \
+ guix/gnunet-download.scm \
guix/hg-download.scm \
guix/swh.scm \
guix/monads.scm \
@@ -187,6 +188,7 @@ MODULES = \
guix/build/bzr.scm \
guix/build/copy-build-system.scm \
guix/build/git.scm \
+ guix/build/gnunet.scm \
guix/build/hg.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
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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")
(commit "v2.10"))
@end lisp
+
+@vindex gnunet-fetch
+@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.
@end table
@item @code{sha256}
diff --git a/guix/build/gnunet.scm b/guix/build/gnunet.scm
new file mode 100644
index 0000000000..3cee161cc2
--- /dev/null
+++ b/guix/build/gnunet.scm
@@ -0,0 +1,113 @@
+;;; 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
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 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))
+
+;;; Commentary:
+;;;
+;;; This is the build-side support code of (guix gnunet-download). It
allows
+;;; files of which the GNUnet chk-URI is known to be downloaded from
the GNUnet
+;;; file-sharing system. The code has been derived from (guix build
hg).
+;;;
+;;; Code:
+
+;; 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
that
+file; close the file and delete it when leaving the dynamic extent of
this
+call."
+ (let* ((directory (or (getenv "TMPDIR") "/tmp"))
+ (template (string-append directory "/guix-file.XXXXXX"))
+ (out (mkstemp! template)))
+ (dynamic-wind
+ (lambda ()
+ #t)
+ (lambda ()
+ (proc template out))
+ (lambda ()
+ (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
otherwise"
+ (let ((s (socket PF_INET SOCK_STREAM 0)))
+ (catch 'system-error
+ (lambda ()
+ (connect s AF_INET INADDR_LOOPBACK port)
+ (close-port s)
+ #t)
+ (lambda (tag function msg msg+ errno)
+ (close-port s)
+ (if (and (equal? function "connect")
+ (equal? errno (list ECONNREFUSED)))
+ #f
+ (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-
download"))
+ "Fetch a file identified by a GNUnet chk-URI @var{URI} into
@var{file}.
+@var{uri} must not be a directory. Return #t on success, #f
otherwise."
+ (guard (c ((invoke-error? c)
+ (format (current-error-port)
+ "gnunet-fetch: '~a~{ ~a~}' failed with exit code
~a~%"
+ (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))
+ #f))
+ (define port
+ (let ((p (getenv "gnunet port")))
+ (and p (< 0 (string-length p))
+ (string->number p))))
+ (define anonymity
+ (let ((a (getenv "GNUNET_ANONYMITY")))
+ (cond ((equal? a "") "1")
+ ((not a) "1")
+ (else a))))
+ ;; 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-
port)
+ (flush-output-port config-output-port)
+ (invoke gnunet-download-command uri
+ "-c" config-file-name
+ "-V" ;; print progress information
+ "-a" anonymity
+ "-o" file)
+ #t))
+ (begin
+ (format (current-error-port)
+ "gnunet-fetch: file-sharing daemon is down.~%")
+ #f))))
+
+;;; gnunet.scm ends here
diff --git a/guix/gnunet-download.scm b/guix/gnunet-download.scm
new file mode 100644
index 0000000000..8a825b90ae
--- /dev/null
+++ b/guix/gnunet-download.scm
@@ -0,0 +1,89 @@
+;;; 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
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 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
hash
+;;; the GNUnet file-sharing system. The hash is specified as a GNUnet
chk-URI
+;;; string. The code has been derived from (guix gx-download).
+;;;
+;;; Code:
+
+(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
+ ;; setup?
+ (let* ((p (open-pipe* OPEN_READ "gnunet-config" "--section" "fs" "-
o" "PORT"))
+ (port (read-line p)))
+ (close-pipe p)
+ (values (format #f "[fs]~%PORT = ~a\n" port)
+ port)))
+
+(define* (gnunet-fetch uri hash-algo hash
+ #:optional name
+ #:key (system (%current-system)) (guile
(default-guile))
+ (gnunet (gnunet-package)))
+ "Return a fixed-output derivation that fetches @var{uri}, a GNUnet
chk-URI
+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
if #f."
+ (define build
+ (with-imported-modules '((guix build gnunet)
+ (guix build utils))
+ #~(begin
+ (use-modules (guix build gnunet))
+ (or (gnunet-fetch '#$uri
+ #$output
+ #:gnunet-download-command
+ (string-append #+gnunet "/bin/gnunet-
download"))))))
+ (define env-vars
+ (call-with-values (lambda () (gnunet-configuration #:gnunet
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
+ #:system system
+ #:local-build? #t ;; don't offload downloads
+ #:hash-algo hash-algo
+ #:hash hash
+ #:recursive? #f
+ #:leaked-env-vars '("GNUNET_ANONYMITY")
+ #:env-vars env-vars
+ #:guile-for-build guile)))
+
+;;; gnunet-download.scm ends here
