guix-gnunet/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 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