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