[gnunet-scheme] 52/324: scripts: download-store: add downloading procedure

[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 adf17748c4dffb4a82bc61c1a4ba50a421de2900
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Jan 25 18:48:26 2021 +0100

    scripts: download-store: add downloading procedure
    
    Seems to work now!
    
    * gnu/gnunet/scripts/download-store.scm
      (download-nar): call 'download-entries!' with rest arguments
      (%help): add comment about umask.
      (gnunet-download): check whether URI is reasonable.
      (download-entries!): new procedure.
---
 gnu/gnunet/scripts/download-store.scm | 44 ++++++++++++++++++++++++++++++++---
 1 file changed, 41 insertions(+), 3 deletions(-)

diff --git a/gnu/gnunet/scripts/download-store.scm 
b/gnu/gnunet/scripts/download-store.scm
index 55359a3..1dcba02 100644
--- a/gnu/gnunet/scripts/download-store.scm
+++ b/gnu/gnunet/scripts/download-store.scm
@@ -26,13 +26,16 @@
          (rnrs io simple)
          (rnrs io ports)
          (rnrs bytevectors)
-         (only (rnrs control) unless)
+         (only (rnrs control) when unless)
          (only (rnrs programs) exit)
          (only (guile)
+               string-any
                string-prefix? system* status:exit-val
                string-split sort negate compose
                dirname
-               throw)
+               throw
+               file-exists? symlink stat mkdir umask
+               chmod stat:mode logior logand lognot getenv)
          (json)
          (srfi srfi-1)
          (srfi srfi-1)
@@ -79,6 +82,8 @@ Download store items from GNUnet using a GNUnet CHK or LOC URI
 (gnunet://fs/chk/...).
 
 The result may contain symbolic links and executables, beware!
+The umask probably should include readability, writability
+and executability.
 Download resumption is currently unsupported.
 
   -v, --version    Print version information
@@ -127,6 +132,11 @@ GNUnet options
                              (no-network #f))
       "Download URI to the file OUTPUT, which is
 created if needed, as a single file."
+      (unless (or (string-prefix? "gnunet://fs/chk/" uri)
+                 (string-prefix? "gnunet://fs/loc/" uri))
+       (throw 'xxx-invalid-uri uri))
+      (when (string-any #\nul uri)
+       (throw 'xxx-invalid-uri uri))
       (let* ((*binary* "gnunet-download")
             (cmd `(,*binary*
                    ,@(if config
@@ -161,7 +171,35 @@ instead of writing to a file."
          (throw 'download-eep 'xxx-proper-error-message))
        (let ((sorted (sort-entries (cdr (assoc "entries" container/scm)))))
          (verify-entries sorted)
-         (download-entries! sorted output))))
+         (apply download-entries! sorted output r))))
+
+    (define* (download-entries! entries output . rest)
+      (define (prefix name)
+       (string-append output "/" name))
+      (define (download-entry! entry)
+       (let* ((type (cdr (assoc "type" entry)))
+              (name (cdr (assoc "name" entry)))
+              (output (prefix name)))
+         (cond ((string=? type "directory")
+                (mkdir output))
+               ((or (string=? type "regular")
+                    (string=? type "executable"))
+                (apply gnunet-download
+                       (cdr (assoc "hash" entry))
+                       output
+                       rest)
+                (when (string=? type "executable")
+                  (chmod output
+                         (logior (stat:mode (stat output))
+                                 (logand #o111 (lognot (umask)))))))
+               ((string=? type "symlink")
+                ;; FIXME check whether guile rejects
+                ;; \0, or silently trims them off
+                (symlink (cdr (assoc "target" entry)) output))
+               (else ???))))
+      (unless (file-exists? output)
+       (mkdir output))
+      (vector-for-each download-entry! entries))
 
     (define (sort-entries entries)
       "Sort ENTRIES, a list or vector of nar entries,

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