123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114 |
- (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))
- (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))))))
- (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))))
-
-
- (if (or (not port) (gnunet-fs-up? port))
- (call-with-temporary-output-file
- (lambda (config-file-name config-output-port)
-
- (display (getenv "gnunet configuration") config-output-port)
- (flush-output-port config-output-port)
- (invoke gnunet-download-command uri
- "-c" config-file-name
- "-V"
- "-a" anonymity
- "-o" file)
- #t))
- (begin
- (format (current-error-port)
- "gnunet-fetch: file-sharing daemon is down.~%")
- #f))))
|