[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet] 01/01: Add tools to manipulate `file-information` objects, and
From: |
Rémi Birot-Delrue |
Subject: |
[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. |
Date: |
Fri, 21 Aug 2015 18:58:26 +0000 |
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)
- [gnunet] branch master updated (2304d66 -> dc6f74d), Rémi Birot-Delrue, 2015/08/21
- [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 <=