[gnunet-scheme] 49/324: scripts: publish-store: correct file name creation

[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 7b5f1226ca18f064f57ab5c2a34e484be3013fb0
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Jan 25 14:40:23 2021 +0100

    scripts: publish-store: correct file name creation
    
    * gnu/gnunet/scripts/publish-store.scm
      (publish-sxml->json): correct file name creation
---
 gnu/gnunet/scripts/publish-store.scm | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/gnu/gnunet/scripts/publish-store.scm 
b/gnu/gnunet/scripts/publish-store.scm
index 591974f..2fdf689 100644
--- a/gnu/gnunet/scripts/publish-store.scm
+++ b/gnu/gnunet/scripts/publish-store.scm
@@ -202,27 +202,31 @@ as a string."
       "Publish SXML, an SXML as returned by store-item->sxml,
 and return a JSON string representing it, with individual files
 referred to by their hash."
+      (define (path-append left right)
+       (cond ((or (string=? left "") (string=? left "/"))
+              right)
+             (else (string-append left "/" right))))
       (define (flatten-sxml prefix sxml)
        (sxml-match sxml
                    ((regular (@ (name ,name)
                                 (executable? ,executable?)
                                 (data-from-file ,filename)))
-                    `(((name . ,(string-append prefix name))
+                    `(((name . ,(path-append prefix name))
                        (type . ,(if executable?
                                       "executable"
                                       "regular"))
                        (hash . ,(apply publish-object filename r)))))
                    ((symlink (@ (name ,name)
                                 (target ,target)))
-                    `(((name . ,(string-append prefix name))
+                    `(((name . ,(path-append prefix name))
                        (type . "symlink")
                        (target . ,target))))
                    ((directory (@ (name ,name))
                                . ,rest)
-                    `(((name . ,(string-append prefix name))
+                    `(((name . ,(path-append prefix name))
                        (type . "directory"))
                       . ,(concatenate
-                          (map (let ((prefix (string-append prefix "/" name)))
+                          (map (let ((prefix (path-append prefix name)))
                                  (lambda (e)
                                    (flatten-sxml prefix e)))
                                rest))))))

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