diff --git a/examples/search.scm b/examples/search.scm index d0369b2..0a5f140 100755 --- a/examples/search.scm +++ b/examples/search.scm @@ -27,53 +27,43 @@ #:use-module (gnu gnunet scheduler) #:export (main)) -;; (use-modules (ice-9 match)) -;; (use-modules (system foreign)) -;; (use-modules (gnu gnunet container metadata)) -;; (use-modules (gnu gnunet fs)) -;; (use-modules (gnu gnunet fs uri)) -;; (use-modules (gnu gnunet fs progress-info)) -;; (use-modules (gnu gnunet configuration)) -;; (use-modules (gnu gnunet scheduler)) - (define config-file "~/.gnunet/gnunet.conf") -(define count-limit 10) -(define (result-cb %info) - (match (parse-c-progress-info %info) - (((context cctx pctx query duration anonymity - (metadata uri result applicability-rank)) status handle) - (match (parse-c-struct result '(* * * *)) ; incomplete parse of result - ((_ _ %uri %metadata) - (let* ((uri (uri->string (wrap-uri %uri))) - (meta (wrap-metadata %metadata)) - (result-directory? (is-directory? meta)) - (result-filename (metadata-ref meta #:original-filename))) - (cond ((and result-directory? - (string-null? result-filename)) - (simple-format #t - "gnunet-download -o \"collection.gnd\" -R ~a\n" - uri)) - (result-directory? - (simple-format #t - "gnunet-download -o \"~a.gnd\" -R ~a\n" - result-filename uri)) - ((string-null? result-filename) - (simple-format #t "gnunet-download ~a\n" - uri)) - (else - (simple-format #t "gnunet-download -o \"~a\" ~a\n" - result-filename uri))))))))) +(define (progress-cb %info) + (when (equal? '(#:search #:result) (progress-info-status %info)) + (match (parse-c-progress-info %info) + (((context cctx pctx query duration anonymity + (metadata uri result applicability-rank)) status handle) + (match (parse-c-struct result '(* * * *)) ; incomplete parse of result + ((_ _ %uri %metadata) + (let* ((uri (uri->string (wrap-uri %uri))) + (meta (wrap-metadata %metadata)) + (result-directory? (is-directory? meta)) + (result-filename (metadata-ref meta #:original-filename))) + (cond ((and result-directory? + (string-null? result-filename)) + (simple-format + #t "gnunet-download -o \"collection.gnd\" -R ~a\n" uri)) + (result-directory? + (simple-format #t + "gnunet-download -o \"~a.gnd\" -R ~a\n" + result-filename uri)) + ((string-null? result-filename) + (simple-format #t "gnunet-download ~a\n" + uri)) + (else + (simple-format #t "gnunet-download -o \"~a\" ~a\n" + result-filename uri)))))))))) (define (main args) (let ((config (load-configuration config-file))) (define (first-task _) - (let ((search-service - (search-service-open config #:result result-cb))) - (let ((current-search (start-ksk-search search-service (cdr args)))) - ;; adds a timeout in 5 seconds - (add-task! (lambda (_) - (stop-search current-search)) - #:delay (* 5 1000 1000))))) + (let* ((fs-service (open-filesharing-service config (car args) + progress-cb)) + (uri (apply make-ksk-uri (cdr args))) + (search (start-search fs-service uri))) + ;; adds a timeout in 5 seconds + (add-task! (lambda (_) (stop-search search)) + #:delay (* 5 1000 1000)))) (call-with-scheduler config first-task))) diff --git a/gnu/gnunet/common.scm b/gnu/gnunet/common.scm index fc54f5c..7aa6a35 100644 --- a/gnu/gnunet/common.scm +++ b/gnu/gnunet/common.scm @@ -28,6 +28,7 @@ time-relative time-absolute ecdsa-public-key + ecdsa-public-key? eddsa-public-key eddsa-signature hashcode @@ -41,7 +42,9 @@ %make-blob-pointer %malloc - %free)) + %free + + string->data-pointer)) (define (generate n x) @@ -59,6 +62,10 @@ eddsa-public-key)) (define hashcode (list (generate 16 uint32))) +(define (ecdsa-public-key? key) + (and (string? key) + (= (/ 258 8) (string-length key)))) + (define gnunet-ok 1) (define gnunet-system-error -1) (define gnunet-yes 1) @@ -83,6 +90,11 @@ (define-gnunet %xfree "GNUNET_xfree_" : (list '* '* int) -> void) (define-gnunet %xmalloc "GNUNET_xmalloc_" : (list size_t '* int) -> '*) +;; this function is needed to convert ASCII public keys to a format GNUnet can +;; understand. +(define-gnunet %string-to-data + "GNUNET_STRINGS_string_to_data" : (list '* size_t '* size_t) -> int) + (define %xfilename (string->pointer "guile")) @@ -108,4 +120,12 @@ ;; (syntax-rules () ;; ((_ (config-file-name) thunk) ;; (let ((cfg-handle (load-configuration config-file-name))) - + +(define (string->data-pointer str data-len) + (let* ((%data (bytevector->pointer (make-bytevector data-len 0))) + (ret (%string-to-data (string->pointer str) (string-length str) + %data data-len))) + (when (not (= gnunet-ok ret)) + (throw 'invalid-result "string->data-pointer" "%string-to-data" + (list str data-len))) + %data)) diff --git a/gnu/gnunet/fs.scm b/gnu/gnunet/fs.scm index 69aa8c9..5541b17 100644 --- a/gnu/gnunet/fs.scm +++ b/gnu/gnunet/fs.scm @@ -23,10 +23,11 @@ #:use-module (gnu gnunet container metadata) #:use-module (gnu gnunet fs uri) #:use-module (gnu gnunet fs progress-info) - #:export (search-service-open - start-ksk-search + #:export (open-filesharing-service + start-search stop-search is-directory?)) + (define struct-fs-handle (list '* '* '* '* '* '* '* '* '* '* '* '* '* '* time-relative @@ -43,6 +44,7 @@ (define default-max-parallel-downloads 16) (define default-max-parallel-requests (* 1024 10)) + (define-gnunet-fs %search-start "GNUNET_FS_search_start" : (list '* '* uint32 unsigned-int '*) -> '*) @@ -61,14 +63,17 @@ ;; 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. -;; +;; +;;+TODO: dynamically allocate the entire structure & client-name, so that we can +;; call GNUNET_FS_stop on the returned handle. +;; ;;+TODO: replace value for avg_block_latency with a call to a function ;; akin `(time-relative #:minutes 1)` -(define (%gnunet-fs-start config client-name progress-callback) +(define (%fs-start %config %client-name %progress-callback) (make-c-struct struct-fs-handle - (list (unwrap-configuration config) - (string->pointer client-name) - (progress-callback->pointer progress-callback) + (list %config + %client-name + %progress-callback %null-pointer ; progress-cb closure %null-pointer ; top_head %null-pointer ; top_tail @@ -87,24 +92,25 @@ default-max-parallel-downloads default-max-parallel-requests))) -(define* (search-service-open config - #:key resume resume-result suspend result - result-namespace update error - paused continued result-stopped - result-suspend stopped - #:rest callbacks) - (define (progress-cb %progress-info) - (let* ((status (cadr (progress-info-status %progress-info))) - (callback (getf callbacks status))) - (when callback (callback %progress-info)))) - (%gnunet-fs-start config "gnunet-search" progress-cb)) +(define (open-filesharing-service config client-name progress-callback) + "Set up and return a handle to the filesharing service. CONFIG must be a +configuration handle, CLIENT-NAME a string (a priori the name of your program), +and PROGRESS-CALLBACK a function of one arg (a foreign pointer to a `struct +GNUNET_FS_ProgressInfo`) that will be called every time something happens in the +filesharing service (a search is started, a download is completed, etc.)." + (when (null? client-name) + (throw 'invalid-arg "open-filesharing-service" client-name)) + (%fs-start (unwrap-configuration config) + (string->pointer client-name) + (progress-callback->pointer progress-callback))) -(define (start-ksk-search handle keywords) - (let ((uri (apply make-ksk-uri keywords))) - (%search-start handle (unwrap-uri uri) 0 0 %null-pointer))) +(define (start-search filesharing-handle uri) + (%search-start filesharing-handle + (unwrap-uri uri) + 0 0 %null-pointer)) -(define (stop-search handle) - (%search-stop handle)) +(define (stop-search search-handle) + (%search-stop search-handle)) ;;+TODO: should be (is-directory? search-result) or ;; (result-is-directory? result) diff --git a/gnu/gnunet/fs/uri.scm b/gnu/gnunet/fs/uri.scm index 1a610d7..4727d97 100644 --- a/gnu/gnunet/fs/uri.scm +++ b/gnu/gnunet/fs/uri.scm @@ -29,18 +29,18 @@ uri? make-ksk-uri make-ksk-uri-pointer + make-sks-uri + make-sks-uri-pointer wrap-uri unwrap-uri uri-type - uri-keywords uri->string)) (define-record-type - (%wrap-uri pointer type keywords) + (%wrap-uri pointer type) uri? (pointer unwrap-uri) - (type uri-type) - (keywords uri-keywords)) + (type uri-type)) ;; (define %file-identifier-type @@ -72,15 +72,18 @@ (define-gnunet-fs %uri-ksk-create "GNUNET_FS_uri_ksk_create" : '(* *) -> '*) - +(define-gnunet-fs %uri-sks-create + "GNUNET_FS_uri_sks_create" : '(* *) -> '*) + + (define (keyword-list->string keywords) (string-concatenate/shared (interleave " " keywords))) (define* (wrap-uri pointer #:key (finalize #f)) (when finalize (set-pointer-finalizer! pointer %uri-destroy)) - (%wrap-uri pointer (%uri-get-type pointer) #f)) + (%wrap-uri pointer (%uri-get-type pointer))) (define (make-ksk-uri-pointer . keywords) "Create a foreign pointer to a KSK URI from a list of strings KEYWORDS." @@ -97,13 +100,24 @@ ((eq? %null-pointer %uri) (%free %error-msg) ; we don’t use error-msg (throw 'invalid-arg "make-ksk-uri-pointer" keywords)) - (else - (set-pointer-finalizer! %uri %uri-destroy))) - %uri)) + (else %uri)))) (define (make-ksk-uri . keywords) "Create an of type #:ksk from the list of strings KEYWORDS." - (%wrap-uri (apply make-ksk-uri-pointer keywords) #:ksk keywords)) + (%wrap-uri (apply make-ksk-uri-pointer keywords) #:ksk)) + +(define (make-sks-uri-pointer namespace identifier) + (when (string-null? identifier) + (throw 'invalid-arg "make-sks-uri-pointer" identifier)) + ;; GNUNET_FS_uri_sks_create cannot return a NULL pointer; on memory shortage, + ;; it aborts. + (%uri-sks-create (string->data-pointer namespace (/ 256 8)) + (string->pointer identifier))) + +;;+TODO: divide into four types (ksk, sks, chk, loc) and ship valuable +;; information, such as namespace & identifier (for the sks URIs). +(define (make-sks-uri namespace identifier) + (wrap-uri (make-sks-uri-pointer namespace identifier) #:finalize #t)) (define (%uri-get-type pointer) (let* ((bv (pointer->bytevector pointer (sizeof unsigned-int))) diff --git a/tests/uri.scm b/tests/uri.scm index bd7be8c..81f263c 100644 --- a/tests/uri.scm +++ b/tests/uri.scm @@ -23,10 +23,18 @@ (test-begin "test-fs-uri") ;; make-ksk-uri -(test-error 'invalid-arg (make-ksk-uri)) +(test-error 'invalid-arg (make-ksk-uri-pointer)) (define test-uri (make-ksk-uri "+foo" "bar" "baz")) +;; make-sks-uri + +(define test-ns "M2OC987U9LFJHQ8LC9SLCV4Q0ONHJV7FMTFQ2VRPE0M9R9MK5860") + +(test-error 'invalid-arg (make-sks-uri-pointer test-ns "")) + +(test-assert (uri? (make-sks-uri test-ns "foo"))) + ;; uri->string (test-assert (not (string-null? (uri->string test-uri))))