[gnunet] 02/17: 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.

[Rémi Birot-Delrue]

remibd pushed a commit to branch master
in repository gnunet.

commit bee3516b83b1cde5cdd6320dae9cf2d1589cf011
Author: RĂ©mi Birot-Delrue <address@hidden>
Date:   Fri Jul 3 13:39:56 2015 +0200

    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.
---
 examples/search.scm   |   74 +++++++++++++++++++++---------------------------
 gnu/gnunet/common.scm |   24 ++++++++++++++-
 gnu/gnunet/fs.scm     |   52 +++++++++++++++++++---------------
 gnu/gnunet/fs/uri.scm |   34 ++++++++++++++++------
 tests/uri.scm         |   10 ++++++-
 5 files changed, 116 insertions(+), 78 deletions(-)

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 <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)))
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))))