guix
/
gnunet
mirror of git://git.savannah.gnu.org/guix/gnunet.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Add draft support for indexing/publication. 

* fs.scm:
  - add a `<file-information>` type and associated functions
    (`wrap-file-information`, `unwrap-file-information`, and
    `make-file-information`);
  - add incomplete bindings to `GNUNET_FS_directory_scan_*` functions
    (`start-directory-scan`, `stop-directory-scan`, `directory-scanner-result`)
  - add `share-tree->file-information`
  - add `start-publish` and `stop-publish`
* examples/publish.scm: a very simple and ugly `gnunet-publish` clone.
This commit is contained in:
Rémi Birot-Delrue 2015-07-21 13:03:07 +02:00
parent 6fc73cee9b
commit 8f48b792a2
2 changed files with 300 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
examples/publish.scm Executable file
View File

@ -0,0 +1,111 @@
#!/usr/bin/guile \
-e (@\ (gnunet-publish)\ main) -L . -s
!#
;;;; Copyright © 2015 Rémi Delrue <asgeir@free.fr>
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnunet-publish)
#:use-module (ice-9 match)
#:use-module (system foreign)
#:use-module (gnu gnunet common)
#:use-module (gnu gnunet fs)
#:use-module (gnu gnunet fs uri)
#:use-module (gnu gnunet fs progress-info)
#:use-module (gnu gnunet configuration)
#:use-module (gnu gnunet scheduler)
#:export (main))
(define config-file "~/.gnunet/gnunet.conf")
(define *fs-handle* #f)
(define *publish-handle* #f)
(define *dir-scanner* #f)
(define *kill-task* #f)
(define (progress-cb %info)
(let ((status (progress-info-status %info)))
(cond ((equal? status '(#:publish #:start))
(match (parse-c-progress-info %info)
(((%context %file-info cctx pctx %filename . _) _ _)
(simple-format #t "Indexing `~a'.\n"
(pointer->string %filename)))))
((equal? status '(#:publish #:completed))
(match (parse-c-progress-info %info)
(((%context %file-info cctx pctx %filename _ _ _ _ _
(chk-uri)) _ _)
(simple-format #t "Indexed `~a'.\n~a"
(pointer->string %filename)
(uri->string (wrap-uri chk-uri)))))
(when *kill-task* (cancel-task! *kill-task*))
(set! *kill-task*
(set-next-task! (lambda (_)
(stop-publish *publish-handle*)))))
(else
(simple-format #t "Got status ~a\n" status)))))
(define* (start-publish-file filesharing-handle filename
#:key simulate? (index? #t))
(define (scan-progress-cb filename directory? reason)
(case reason
((#:finished)
(let* ((%share-tree #f)
(file-info #f))
(set! %share-tree (directory-scanner-result filesharing-handle
*dir-scanner*))
(set! *dir-scanner* #f)
(set! file-info (share-tree->file-information filesharing-handle
%share-tree index?))
(set! %share-tree #f)
(set! *publish-handle*
(start-publish filesharing-handle (unwrap-file-information file-info)
#:simulate? simulate?))
(when *kill-task* (cancel-task! *kill-task*))
(set! *kill-task*
(add-task! (lambda (_)
(stop-publish *publish-handle*)
(simple-format #t
"Stopped publication.\n"))
#:delay (* 5 1000 1000)))))
((#:internal-error)
(simple-format #t "scan-progress-cb: internal error.\n")
(when *kill-task* (cancel-task! *kill-task*))
(set! *kill-task*
(set-next-task! (lambda (_)
(stop-directory-scan *dir-scanner*)
(simple-format #t
"Stopped directory scanner.\n")))))))
(set! *dir-scanner* (start-directory-scan filename scan-progress-cb))
(when *kill-task* (cancel-task! *kill-task*))
(set! *kill-task*
(add-task! (lambda (_)
(simple-format #t "stopping directory scanner (2) ~a\n"
*dir-scanner*)
(stop-directory-scan *dir-scanner*)
(simple-format #t
"Stopped directory scanner.\n"))
#:delay (* 5 1000 1000))))
(define (main args)
(let ((config (load-configuration config-file)))
(define (first-task _)
(match args
((binary-name filename)
(set! *fs-handle* (open-filesharing-service config binary-name
progress-cb))
(start-publish-file *fs-handle* filename))))
(call-with-scheduler config first-task)))

196
gnu/gnunet/fs.scm
View File

@ -15,7 +15,10 @@
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;+TODO: export <file-information>
(define-module (gnu gnunet fs)
#:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:use-module (system foreign)
#:use-module (gnu gnunet binding-utils)
#:use-module (gnu gnunet common)
@ -23,12 +26,23 @@
#:use-module (gnu gnunet container metadata)
#:use-module (gnu gnunet fs uri)
#:use-module (gnu gnunet fs progress-info)
#:export (open-filesharing-service
#:use-module (gnu gnunet scheduler)
#:export (<file-information>
wrap-file-information
unwrap-file-information
open-filesharing-service
start-search
stop-search
start-download
stop-download
is-directory?))
start-publish
stop-publish
is-directory?
start-directory-scan
stop-directory-scan
directory-scanner-result
share-tree->file-information))
(define struct-fs-handle
@ -48,6 +62,34 @@
(define default-max-parallel-requests (* 1024 10))
(define-gnunet-fs %file-information-create-from-file
"GNUNET_FS_file_information_create_from_file" :
(list '* '* '* '* '* int '*) -> '*)
(define-gnunet-fs %file-information-get-filename
"GNUNET_FS_file_information_get_filename" : '(*) -> '*)
(define-gnunet-fs %file-information-is-directory
"GNUNET_FS_file_information_is_directory" : '(*) -> int)
(define-gnunet-fs %file-information-destroy
"GNUNET_FS_file_information_destroy" : '(* * *) -> void)
(define-gnunet-fs %directory-scan-start
"GNUNET_FS_directory_scan_start" : (list '* int '* '* '*) -> '*)
(define-gnunet-fs %directory-scan-abort
"GNUNET_FS_directory_scan_abort" : '(*) -> void)
(define-gnunet-fs %directory-scan-get-result
"GNUNET_FS_directory_scan_get_result" : '(*) -> '*)
(define-gnunet-fs %share-tree-trim!
"GNUNET_FS_share_tree_trim" : '(*) -> void)
(define-gnunet-fs %share-tree-free
"GNUNET_FS_share_tree_free" : '(*) -> void)
(define-gnunet-fs %search-start
"GNUNET_FS_search_start" : (list '* '* uint32 unsigned-int '*) -> '*)
@ -61,14 +103,135 @@
(define-gnunet-fs %download-stop
"GNUNET_FS_download_stop" : (list '* int) -> void)
(define-gnunet-fs %publish-start
"GNUNET_FS_publish_start" : (list '* '* '* '* '* unsigned-int) -> '*)
(define-gnunet-fs %publish-stop
"GNUNET_FS_publish_stop" : (list '*) -> void)
(define-gnunet-fs %test-for-directory
"GNUNET_FS_meta_data_test_for_directory" : (list '*) -> int)
(define-record-type <file-information>
(wrap-file-information pointer)
file-information?
(pointer unwrap-file-information))
(define* (make-file-information filesharing-handle filename
#:key keywords metadata (index? #t))
(when (string-null? filename)
(throw 'invalid-arg "make-file-information" filename))
(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)))
(wrap-file-information (%file-information-create-from-file
filesharing-handle %null-pointer %filename
%keywords-str %metadata %index? %null-pointer))))
(define (file-information-filename file-info)
(%file-information-get-filename (unwrap-file-information file-info)))
(define (file-information-directory? file-info)
(%file-information-is-directory (unwrap-file-information file-info)))
(define (file-information-destroy %file-info)
"Free a file-information structure.
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 (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
associated memory is freed)."
(let ((res (%directory-scan-get-result scanner)))
(%share-tree-trim! res)
res))
;; block options
;;
;; this value must remain accessible for the C functions as long as
;; the file-information that refers it are alive.
(define *block-options*
(make-c-struct (list uint64 uint32 uint32 uint32) '(0 0 365 1)))
(define (share-tree->file-information filesharing-handle share-tree index?)
"Transform a pointer to a “share-tree” to an instance of <file-information>.
WARNING: the share-tree is unusable after a call to
SHARE-TREE->FILE-INFORMATION (the associated memory is freed)."
(match (parse-c-struct share-tree
(list '* '* '* '* '* '* '* '* '* int))
((_ _ _ _ _ %metadata %ksk-uri %filename _ %is-directory)
(when (= gnunet-ok %is-directory)
(throw 'unimplemented "share-tree->file-information"
%directory-scan-get-result (list (pointer->string* %filename))))
(let ((%fi (%file-information-create-from-file
filesharing-handle %null-pointer %filename %ksk-uri %metadata
(bool->int index?) *block-options*)))
(when (eq? %null-pointer %fi)
(throw 'invalid-result "share-tree->file-information"
"%file-information-create-from-file"
(list filesharing-handle %filename %ksk-uri
%metadata (bool->int index?))))
(%share-tree-free share-tree)
(wrap-file-information %fi)))))
(define directory-scanner-progress-update-reason-alist
'((0 . #:file-start)
(1 . #:file-ignored)
(2 . #:all-counted)
(3 . #:extract-finished)
(4 . #:finished)
(5 . #:internal-error)))
(define (number->reason n)
(assoc-ref directory-scanner-progress-update-reason-alist n))
(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
#: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 update.
PROGRESS-CB must be a procedure of three arguments:
– the filename of the file currently being scanned;
– a boolean, true if the current file is in fact a directory;
– the reason of the update, a keyword from the set:
#:file-start #:file-ignored #:all-counted
#:extract-finished #:finished #:internal-error"
(when (string-null? filename)
(throw 'invalid-arg "start-directory-scan" filename))
(let ((%filename (string->pointer filename))
(%disable-extractor? (if disable-extractor? gnunet-yes gnunet-no))
(%callback (scan-progress-callback->pointer progress-cb)))
(%directory-scan-start %filename %disable-extractor? %null-pointer
%callback %null-pointer)))
(define (stop-directory-scan scanner)
"Abort a scan.
WARNING: must NEVER be called inside the “progress callback” of the scanner;
instead, use ADD-TASK! or SET-NEXT-TASK! to schedule its call outside the
callback."
(%directory-scan-abort scanner))
(define (progress-callback->pointer thunk)
(procedure->pointer '* (lambda (cls info)
(thunk info)
%null-pointer)
(list '* '*)))
(procedure->pointer '* (lambda (cls info)
(thunk info)
%null-pointer)
(list '* '*)))
;; This is a temporary replacement for the actual GNUNET_FS_start function that
;; is variadic and, hence, not currently handlable by Guile’s Dynamic FFI.
@ -127,8 +290,27 @@ filesharing service (a search is started, a download is completed, etc.)."
(uri-file-size uri) 0 0 %null-pointer %null-pointer))
(define* (stop-download download-handle #:key delete-incomplete?)
(%download-stop download-handle (if delete-incomplete? 1 0)))
(%download-stop download-handle (if delete-incomplete? gnunet-yes gnunet-no)))
(define* (start-publish filesharing-handle file-information
#:key namespace namespace-identifier
update-identifier simulate?)
"Publish a file or a directory. If SIMULATE? is #t, no data will be stored in
the datastore."
(let ((%namespace (or namespace %null-pointer))
(%namespace-id (or namespace-identifier %null-pointer))
(%update-id (or update-identifier %null-pointer))
(%option (if simulate? gnunet-yes gnunet-no)))
(%publish-start filesharing-handle file-information
%namespace %namespace-id %update-id %option)))
(define (stop-publish publish-handle)
"Stops a publication.
WARNING: must NEVER be called inside the “progress callback” of the Filesharing
system; instead, use ADD-TASK! or SET-NEXT-TASK! to schedule its call outside
the callback."
(%publish-stop publish-handle))
;;+TODO: should be (is-directory? search-result) or
;; (result-is-directory? result)