[gnunet-scheme] 48/324: scripts: download-store: download json container

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit 69f8df63b1342a2eea7efc0f6597dfb88b9c0fdc
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Jan 23 23:31:19 2021 +0100

    scripts: download-store: download json container
    
    * gnu/gnunet/scripts/download-store.scm
      (main, download-nar): change argument format of
      'gnunet-download'
      (gnunet-download): new procedure, downloading a file to disk
      (gnunet-download/bytevector): new procedure, downloading to
      a fresh bytevector
      (download-nar): download the JSON container
---
 gnu/gnunet/scripts/download-store.scm | 62 ++++++++++++++++++++++++++++++-----
 1 file changed, 53 insertions(+), 9 deletions(-)

diff --git a/gnu/gnunet/scripts/download-store.scm 
b/gnu/gnunet/scripts/download-store.scm
index d17f9e0..093ef58 100644
--- a/gnu/gnunet/scripts/download-store.scm
+++ b/gnu/gnunet/scripts/download-store.scm
@@ -16,15 +16,21 @@
 ;;
 ;;   SPDX-License-Identifier: AGPL-3.0-or-later
 
+;; TODO: parallel downloads
 (library (gnu gnunet scripts download-store)
   (export main)
-  (import (ice-9 optargs)
+  (import (gnu gnunet scripts guix-stuff)
+         (ice-9 optargs)
          (ice-9 getopt-long)
          (rnrs base)
          (rnrs io simple)
+         (rnrs io ports)
+         (rnrs bytevectors)
+         (only (rnrs control) unless)
          (only (rnrs programs) exit)
-         (only (guile) string-prefix?)
-         (srfi srfi-1)
+         (only (guile)
+               string-prefix? system* status:exit-val)
+         (json)          (srfi srfi-1)
          (srfi srfi-26))
   (begin
     (define %supported-formats
@@ -96,8 +102,8 @@ GNUnet options
               (newline))
              ((member (option-ref options 'format "gnunet-nix-archive-json/0")
                       '("gnunet-nix-archive-json/0" "any"))
-              (download-nar #:input (option-ref options 'input #f)
-                            #:output (option-ref options 'output #f)
+              (download-nar (option-ref options 'input #f)
+                            (option-ref options 'output #f)
                             #:config (option-ref options 'config #f)
                             #:no-network (option-ref options 'no-network #f)
                             #:anonymity
@@ -105,7 +111,45 @@ GNUnet options
                              (option-ref options 'anonymity "1"))))
              (else ???))))
 
-    (define* (download-nar #:key
-                          #:allow-other-keys
-                          #:rest r)
-      ???)))
+    (define* (gnunet-download uri
+                             output-filename
+                             #:key
+                             (config (string-append
+                                      (getenv "HOME")
+                                      "/.config/gnunet.conf"))
+                             (anonymity 1)
+                             (no-network #f))
+      "Download URI to the file OUTPUT, which is
+created if needed, as a single file."
+      (let* ((*binary* "gnunet-download")
+            (cmd `(,*binary*
+                   ,@(if config
+                         `("-c" ,config)
+                         '())
+                   ,@(if no-network
+                         '("-n")
+                         '())
+                   "-a" ,(number->string anonymity)
+                   "-o" ,output-filename
+                   ,uri))
+            (result (apply system* cmd)))
+       (unless (= (status:exit-val result) 0)
+         ;; XXX proper error message
+         (throw 'gnunet-download-eep 'gnunet-download-???))
+       (values)))
+
+    (define* (gnunet-download/bytevector uri #:rest r)
+      "Like gnunet-download, but return a bytevector
+instead of writing to a file."
+      (call-with-temporary-output-file
+       (lambda (filename out)
+        (apply gnunet-download uri filename r)
+        (get-bytevector-all out))))
+
+    (define* (download-nar uri output #:rest r)
+      (let* ((container/bv (apply gnunet-download/bytevector uri r))
+            (container/json (utf8->string container/bv))
+            (container/scm (json-string->scm container/json)))
+       (display container/scm)
+       (display 'do-stuff-please)
+       ???))))

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.