diff --git a/examples/publish.scm b/examples/publish.scm new file mode 100755 index 0000000..0979f73 --- /dev/null +++ b/examples/publish.scm @@ -0,0 +1,111 @@ +#!/usr/bin/guile \ +-e (@\ (gnunet-publish)\ main) -L . -s +!# +;;;; Copyright © 2015 Rémi Delrue +;;;; +;;;; 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 . + +(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))) diff --git a/gnu/gnunet/fs.scm b/gnu/gnunet/fs.scm index 2e71386..f297663 100644 --- a/gnu/gnunet/fs.scm +++ b/gnu/gnunet/fs.scm @@ -15,7 +15,10 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with this program. If not, see . +;;+TODO: export (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 ( + 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 + (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 . + +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)