[gnunet-scheme] 36/324: scripts: publish-store: eliminate add-name

[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 01e88c0f87fdb03d3de92442de5c5d2c2bb085c0
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Jan 23 12:33:08 2021 +0100

    scripts: publish-store: eliminate add-name
    
    I experimented with ‘gnunet-publish’ a little,
    and it seems like the basename of published directories
    is included in the .gnd. Make this more explicit in the code.
    
    (Regular files that are published as-is don't have a
    file name included.)
    
    * gnu/gnunet/scripts/publish-store.scm
      (store-item->sxml): include basename
      (directory->sxmls): don't add the basename here
      (add-name): deleted procedure
---
 gnu/gnunet/scripts/publish-store.scm | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/gnu/gnunet/scripts/publish-store.scm 
b/gnu/gnunet/scripts/publish-store.scm
index fff8b88..a0aedd7 100644
--- a/gnu/gnunet/scripts/publish-store.scm
+++ b/gnu/gnunet/scripts/publish-store.scm
@@ -17,6 +17,12 @@
 ;;   SPDX-License-Identifier: AGPL-3.0-or-later
 
 ;; Brief: publish an item of the store (GNU Guix) to GNUnet
+;; A quirk of the directory format to keep in mind:
+;;  * the basename of the directory is saved in the .gnd
+;;  * the basename of regular files that are published
+;;     as-is isn't saved (but is included in the surrounding
+;;     .gnd)
+
 (library (gnu gnunet scripts publish-store)
   (export main)
   (import (rnrs base)
@@ -25,6 +31,8 @@
          (only (ice-9 ftw) scandir)
          (only (srfi srfi-1) member)
          (only (guile)
+               basename
+               readlink
                logand
                lstat
                stat:type
@@ -85,7 +93,8 @@ GNUnet options
       ???)
 
     (define (store-item->sxml filename)
-      (let* ((stat  (lstat filename))
+      (let* ((name  (basename filename))
+            (stat  (lstat filename))
             (type  (stat:type stat))
             (perms (stat:perms stat))
             (executable?
@@ -93,33 +102,24 @@ GNUnet options
                 #o0001)))
        (case (stat:type stat)
          ((regular)
-          `(regular (@ (size ,(stat:size stat))
+          `(regular (@ (name ,name)
+                       (size ,(stat:size stat))
                        (executable? ,executable?)
                        (data-from-file ,filename))))
          ((directory)
-          `(directory ,@(directory->sxmls filename)))
+          `(directory (@ (name ,name))
+                      ,@(directory->sxmls filename)))
          ((symlink)
-          `(symlink (@ (target ,(readlink filename)))))
+          `(symlink (@ (name ,name)
+                       (target ,(readlink filename)))))
          (else ???))))
 
-    ;; FIXME I can't use sxml-match properly
-    (define (add-name sxml name)
-      (cons (car sxml)
-           (if (and (pair? (cdr sxml))
-                    (eq? (caadr sxml) '@))
-               `((@ (name ,name) . ,(cdadr sxml))
-                 . ,(cddr sxml))
-               `((@ (name ,name))
-                 . ,(cdr sxml)))))
-
     (define (directory->sxmls filename)
       (let ((names (scandir filename
                            (lambda (n)
                              (not (member n '("." ".."))))
                            string<?)))
        (map (lambda (name)
-              (add-name (store-item->sxml (string-append filename
-                                                         "/"
-                                                         name))
-                        name))
+              (let ((file (string-append filename "/" name)))
+                (store-item->sxml file)))
             names)))))

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