API cleanup: separates search and URI, adds sks URIs.
* examples/search.scm: echo changes in the API;
* gnu/gnunet/common.scm: add ecdsa-public-key? and string->data-pointer;
* gnu/gnunet/fs.scm: replace search-service-open with open-filesharing-service,
replace start-ksk-search with start-search;
* gnu/gnunet/fs/uri.scm: add make-sks-uri-pointer and make-sks-uri;
* tests/uri.scm: add tests for make-sks-uri-pointer and make-sks-uri.
This commit is contained in:
Rémi Birot-Delrue
parent
c294a124d8
commit
bee3516b83
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 <uri>
|
||||
(%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 <uri> 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 <uri> 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)))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue