[gnunet] 01/01: Add tools to manipulate `file-information` objects, and a few other things. * common.scm: add the constant `%time-relative-forever`. * container/metadata.scm: add `#:filename` and `#:narinfo` meta-types. * fs.scm: add tools to create and manipulate `file-information` objects: `file-information-add!`, `file-information-iterate`, `file->file-information` and `directory->file-information`, remove `make-file-information`. * tests/fs.scm: test those functions a little.

[Rémi Birot-Delrue]

remibd pushed a commit to branch master
in repository gnunet.

commit dc6f74d269fcb324d8649f3c511299b7ba2be2a4
Author: RĂ©mi Birot-Delrue <address@hidden>
Date:   Fri Aug 21 20:50:56 2015 +0200

    Add tools to manipulate `file-information` objects, and a few other things.
    * common.scm: add the constant `%time-relative-forever`.
    * container/metadata.scm: add `#:filename` and `#:narinfo` meta-types.
    * fs.scm: add tools to create and manipulate `file-information` objects:
              `file-information-add!`, `file-information-iterate`,
              `file->file-information` and `directory->file-information`,
          remove `make-file-information`.
    * tests/fs.scm: test those functions a little.
---
 gnu/gnunet/common.scm             |   28 +++++---
 gnu/gnunet/container/metadata.scm |    7 ++-
 gnu/gnunet/fs.scm                 |  135 ++++++++++++++++++++++++++++++-------
 tests/fs.scm                      |   19 ++++--
 4 files changed, 145 insertions(+), 44 deletions(-)

diff --git a/gnu/gnunet/common.scm b/gnu/gnunet/common.scm
index d1d1337..eeb3c48 100644
--- a/gnu/gnunet/common.scm
+++ b/gnu/gnunet/common.scm
@@ -19,6 +19,7 @@
   #:use-module (system foreign)
   #:use-module (rnrs base)
   #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
   #:use-module (gnu gnunet binding-utils)
   #:export (gnunet-ok
             gnunet-system-error
@@ -67,6 +68,8 @@
 (define time-relative uint64)
 (define time-absolute uint64)
 
+(define %time-relative-forever #xffffffffffffffff) ; UINT64_MAX
+
 (define ecdsa-public-key (generate (/ 256 8 4) uint32))
 (define eddsa-public-key ecdsa-public-key)
 (define eddsa-signature (list eddsa-public-key
@@ -147,17 +150,20 @@ writing, LOG-LEVEL is a keyword from (#:none #:error 
#:warning #:info #:debug
               (string->pointer* log-file)))
 
 (define* (time-rel #:key (days 0) (hours 0) (minutes 0)
-                         (seconds 0) (milli 0) (micro 0))
-  (let* ((hours*   (+ (* days     24)   hours))
-         (minutes* (+ (* hours*    60)  minutes))
-         (seconds* (+ (* minutes* 60)   seconds))
-         (milli*   (+ (* seconds* 1000) milli))
-         (micro*   (+ (* milli*   1000) micro)))
-    (when (negative? micro*)
-      (scm-error 'out-of-range "time-rel"
-                 "result (~a) is negative" (list micro*)
-                 (list hours minutes seconds milli micro)))
-    (inexact->exact micro*)))
+                   (seconds 0) (milli 0) (micro 0) #:rest rest)
+  (match rest
+    ((#:forever) %time-relative-forever)
+    (_
+     (let* ((hours*   (+ (* days     24)   hours))
+            (minutes* (+ (* hours*    60)  minutes))
+            (seconds* (+ (* minutes* 60)   seconds))
+            (milli*   (+ (* seconds* 1000) milli))
+            (micro*   (+ (* milli*   1000) micro)))
+       (when (negative? micro*)
+         (scm-error 'out-of-range "time-rel"
+                    "result (~a) is negative" (list micro*)
+                    (list hours minutes seconds milli micro)))
+       (inexact->exact micro*)))))
 
 (define (current-time)
   "Get the current time as an absolute time."
diff --git a/gnu/gnunet/container/metadata.scm 
b/gnu/gnunet/container/metadata.scm
index 9437ead..b50f7ed 100644
--- a/gnu/gnunet/container/metadata.scm
+++ b/gnu/gnunet/container/metadata.scm
@@ -74,9 +74,12 @@
              #:unknown)))
 
 (define metadata-type-alist
-  '((#:publication-date  .  24)
+  '((#:filename          .   2)
+    (#:publication-date  .  24)
     (#:unknown           .  45)
-    (#:original-filename . 180)))
+    (#:original-filename . 180)
+    ;; temporary until the right meta-type is added to libextractor
+    (#:narinfo           . 230)))
 
 (define (metadata-type->integer type)
   (or (assq-ref metadata-type-alist type)
diff --git a/gnu/gnunet/fs.scm b/gnu/gnunet/fs.scm
index 048d1ee..0a11c7a 100644
--- a/gnu/gnunet/fs.scm
+++ b/gnu/gnunet/fs.scm
@@ -17,6 +17,7 @@
 
 (define-module (gnu gnunet fs)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (system foreign)
   #:use-module (gnu gnunet binding-utils)
@@ -32,6 +33,8 @@
             unwrap-file-information
             file-information-filename
             file-information-directory?
+            file-information-add!
+            file-information-iterate
 
             make-block-options
             open-filesharing-service
@@ -44,7 +47,10 @@
             stop-publish
             is-directory?
             ;; to publish a single file
-            make-file-information))
+            file->file-information%
+            file->file-information
+            directory->file-information%
+            directory->file-information))
             ;; to publish a directory
             ;; buggy/unfinished
 ;            start-directory-scan
@@ -77,6 +83,13 @@
   "GNUNET_FS_file_information_create_from_file" :
     (list '* '* '* '* '* int '*) -> '*)
 
+(define-gnunet-fs %file-information-create-empty-directory
+  "GNUNET_FS_file_information_create_empty_directory" :
+    '(* * * * * *) -> '*)
+
+(define-gnunet-fs %file-information-add!
+  "GNUNET_FS_file_information_add" : '(* *) -> int) 
+
 (define-gnunet-fs %file-information-get-filename
   "GNUNET_FS_file_information_get_filename" : '(*) -> '*)
 
@@ -86,6 +99,9 @@
 (define-gnunet-fs %file-information-destroy
   "GNUNET_FS_file_information_destroy"      : '(* * *) -> void)
 
+(define-gnunet-fs %file-information-inspect
+  "GNUNET_FS_file_information_inspect"      : '(* * *) -> void)
+
 (define-gnunet-fs %directory-scan-start
   "GNUNET_FS_directory_scan_start"      : (list '* int '* '* '*) -> '*)
 
@@ -138,28 +154,57 @@ blocks."
   file-information?
   (pointer unwrap-file-information))
 
-(define* (make-file-information filesharing-handle filename block-options
-                                #:key (keywords '()) metadata (index? #t))
-  "Builds a <file-information> object from FILENAME to be published under
+(define (call-with-fileinfo-args name f path keywords metadata block-options)
+  "Check if PATH and BLOCK-OPTIONS are valid, then call F on PATH, KEYWORDS and
+METADATA as pointers."
+  (when (string-null? path)
+    (throw 'invalid-arg name path))
+  (when (or (null? block-options) (not (pointer? block-options)))
+    (throw 'invalid-arg name block-options))
+  (f (string->pointer* path)
+     (string->pointer* (keyword-list->string keywords))
+     (if metadata (unwrap-metadata metadata) %null-pointer)))
+
+(define-syntax-rule (with-fileinfo-args (name path keywords metadata
+                                         block-options)
+                                        %args expr expr* ...)
+  (call-with-fileinfo-args name (lambda %args expr expr* ...)
+                           path keywords metadata block-options))
+
+(define* (file->file-information% filesharing-handle path block-options
+                                  #:key (keywords '()) metadata (index? #t))
+  "Builds a file information object from PATH to be published under
 BLOCK-OPTIONS.
 
 KEYWORDS is a list of additional keywords (as strings) under which the file 
will
 be published, METADATA is some initial metadata, and INDEX? specifies if the
 file should be indexed or not (#t by default)."
-  (when (string-null? filename)
-    (throw 'invalid-arg "make-file-information" filename))
-  (when (or (null? block-options) (not (pointer? block-options)))
-    (throw 'invalid-arg "make-file-information" block-options))
-  (let ((%filename     (string->pointer* filename))
-        (%keywords-str (string->pointer* (keyword-list->string keywords)))
-        (%metadata     (if metadata (unwrap-metadata metadata) %null-pointer))
-        (%index?       (if index? gnunet-yes gnunet-no)))
-    (let ((%info (%file-information-create-from-file
-                  filesharing-handle %null-pointer %filename
-                  %keywords-str %metadata %index? block-options)))
-      (if (eq? %null-pointer %info)
-          #f
-          (wrap-file-information %info)))))
+  (with-fileinfo-args ("file->file-information%"
+                       path keywords metadata block-options)
+                      (%path %keywords %metadata)
+    (%file-information-create-from-file filesharing-handle %null-pointer %path
+                                        %keywords %metadata (bool->int index?)
+                                        block-options)))
+
+(define (file->file-information . args)
+  (let ((res (apply file->file-information% args)))
+    (when (eq? %null-pointer res)
+      (throw 'invalid-result "file->file-information"
+             "%file-information-create-from-file"
+             args))
+    (wrap-file-information res)))
+
+(define* (directory->file-information% filesharing-handle path block-options
+                                       #:key (keywords '()) metadata)
+  (with-fileinfo-args ("directory->file-information%"
+                       path keywords metadata block-options)
+                      (%path %keywords %metadata)
+    (%file-information-create-empty-directory filesharing-handle %null-pointer
+                                              %keywords %metadata block-options
+                                              %path)))
+
+(define (directory->file-information . args)
+  (wrap-file-information (apply directory->file-information% args)))
 
 (define (file-information-filename file-info)
   (let ((%s (%file-information-get-filename
@@ -172,6 +217,17 @@ file should be indexed or not (#t by default)."
   (int->bool (%file-information-is-directory
               (unwrap-file-information file-info))))
 
+(define (file-information-add! directory file)
+  "Add FILE to DIRECTORY."
+  (when (eq? %null-pointer directory)
+    (throw 'invalid-arg "file-information-add!" directory))
+  (when (eq? %null-pointer file)
+    (throw 'invalid-arg "file-information-add!" file))
+  (case (%file-information-add! directory file)
+    ((gnunet-ok) *unspecified*)
+    ((gnunet-system-error) (throw 'invalid-result "file-information-add!"
+                                  "%file-information-add!" directory))))
+
 (define (file-information-destroy %file-info)
   "Free a file-information structure.
 
@@ -179,8 +235,37 @@ WARNING: must NEVER be called on a file-info that has been 
given to
 START-PUBLISH. In fact, you should probably not be using this function."
   (%file-information-destroy %file-info %null-pointer %null-pointer))
 
+(define (procedure->file-information-processor f)
+  (define (trim lst) (drop-right! (cdr lst) 1))
+  (procedure->pointer int
+                      (lambda args
+                       (case (apply f (trim args))
+                         ((#:delete) gnunet-no)
+                          ((#:abort)  gnunet-system-error)
+                          (else       gnunet-yes)))
+                      (list '* '* uint64 '* '* '* '* '*)))
+
+(define (file-information-iterate f file-info)
+  "Recursively call F on each file and directory of FILE-INFO.
+
+F is a function of six arguments:
+  – file-information (pointer)
+  – length (integer)
+  – metadata (pointer)
+  – uri (pointer to pointer)
+  – block-options (pointer)
+  – do-index (pointer to integer)
+representing the currently inspected entry. The metadata, block-options
+and do-index slots can be modified.
+
+If can return two special value: #:DELETE to remove the currently inspected
+entry from the collection, and #:ABORT to stop iterating."
+  (%file-information-inspect (unwrap-file-information file-info)
+                             (procedure->file-information-processor f)
+                             %null-pointer))
+
 
-(define (directory-scanner-result filesharing-handle scanner)
+#;(define (directory-scanner-result filesharing-handle scanner)
   "Returns the result of the scan as a pointer to a “share tree”.
 
 WARNING: the scanner is unusable after a call to DIRECTORY-SCANNER-RESULT (the
@@ -189,7 +274,7 @@ associated memory is freed)."
     (%share-tree-trim! res)
     res))
 
-(define (share-tree->file-information filesharing-handle share-tree index?
+#;(define (share-tree->file-information filesharing-handle share-tree index?
                                       block-options)
   "Transform a pointer to a “share-tree” to an instance of <file-information>.
 
@@ -212,7 +297,7 @@ SHARE-TREE->FILE-INFORMATION (the associated memory is 
freed)."
        (%share-tree-free share-tree)
        (wrap-file-information %fi)))))
 
-(define directory-scanner-progress-update-reason-alist
+#;(define directory-scanner-progress-update-reason-alist
   '((0 . #:file-start)
     (1 . #:file-ignored)
     (2 . #:all-counted)
@@ -220,17 +305,17 @@ SHARE-TREE->FILE-INFORMATION (the associated memory is 
freed)."
     (4 . #:finished)
     (5 . #:internal-error)))
 
-(define (number->reason n)
+#;(define (number->reason n)
   (assoc-ref directory-scanner-progress-update-reason-alist n)) 
 
-(define (scan-progress-callback->pointer thunk)
+#;(define (scan-progress-callback->pointer thunk)
   (procedure->pointer void (lambda (_ %filename %is-directory %reason)
                              (thunk (pointer->string* %filename)
                                     (int->bool        %is-directory)
                                     (number->reason   %reason)))
                       (list '* '* int unsigned-int)))
 
-(define* (start-directory-scan filename progress-cb
+#;(define* (start-directory-scan filename progress-cb
                                #:key disable-extractor?)
   "Start a directory scan on FILENAME, extracting metadata (unless
 DISABLE-EXTRACTOR? is #t) and calling PROGRESS-CB each time there’s an
@@ -253,7 +338,7 @@ PROGRESS-CB must be a procedure of three arguments:
          (throw 'invalid-result "start-directory-scan" "%directory-scan-start"
                 %null-pointer))))
 
-(define (stop-directory-scan scanner)
+#;(define (stop-directory-scan scanner)
   "Abort a scan.
 
 WARNING: must NEVER be called inside the “progress callback” of the scanner;
diff --git a/tests/fs.scm b/tests/fs.scm
index 0baa9f5..ef61b73 100644
--- a/tests/fs.scm
+++ b/tests/fs.scm
@@ -27,13 +27,20 @@
 
 ;;; <file-information>
 
-(define readme (make-file-information %null-pointer ; no fs for this test
-                                     "README"
-                                      %block-options
-                                     #:keywords '("manual" "important")
-                                     #:index? #t))
+(define readme  (file->file-information %null-pointer ; no fs for this test
+                                        "README"
+                                        %block-options
+                                        #:keywords '("manual" "important")
+                                        #:index? #t))
 
 (test-equal "README" (file-information-filename   readme))
-(test-equal #f       (file-information-directory? readme))
+(test-assert    (not (file-information-directory? readme)))
+
+(define fs-dir (directory->file-information %null-pointer ; no fs for this test
+                                            "gnu/gnunet/fs"
+                                            %block-options))
+
+(test-equal "gnu/gnunet/fs" (file-information-filename   fs-dir))
+(test-assert                (file-information-directory? fs-dir))
 
 (test-end)