[bug#44199] [PATCH 1/1] guix: Add (guix gnunet-download).

[Maxime Devos <maxime.devos@student.kuleuven.be>]

[-- Attachment #1: Type: text/plain, Size: 11493 bytes --]

This method allows fetching sources over GNUnet's file-sharing
system, presuming GNUnet has been configured on the local system.

Missing:
- time-outs
- fetching substitutes over GNUnet
- fallback to legacy non-P2P servers
- GNUnet system service

* guix/gnunet-download.scm, guix/build/gnunet.scm: New files.
* Makefile.am (MODULES): Add them.
* doc/guix.texi (Defining Packages): Document gnunet-fetch.
---
 Makefile.am              |   2 +
 doc/guix.texi            |   7 +++
 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

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

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 273 bytes --]