[gnunet-scheme] 19/49: dht/client: Recognise client result messages.

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit 6b1ee343ab6ebce5ce0d5d44f0e99fc8d53f01a1
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Sep 24 22:01:29 2021 +0200

    dht/client: Recognise client result messages.
    
    * gnu/gnunet/dht/client.scm
      (<server>)[id->operation-map]: New field.
      (start-get!)[handle]: Extract the id to ...
      (start-get!)[id]: ... here.
      (start-get!): Add the id and operation to the new field.
      (connect): Set new field and adjust call to 'reconnect'.
      (reconnect)[handlers]{msg:dht:client:result}: Call the
      not-yet-defined process-client-result on the handle and slice.
---
 gnu/gnunet/dht/client.scm | 44 ++++++++++++++++++++++++++++++++++++--------
 1 file changed, 36 insertions(+), 8 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 53381ea..0bf6045 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -41,7 +41,8 @@
          (gnu gnunet mq envelope)
          (only (guile)
                pk define-syntax-rule define* error
-               make-hash-table hashq-set! hashq-remove! hash-map->list)
+               make-hash-table hashq-set! hashq-remove! hashv-set! hashv-ref
+               hash-map->list)
          (only (ice-9 atomic)
                make-atomic-box atomic-box-ref atomic-box-set!)
          (only (gnu extractor enum)
@@ -67,7 +68,8 @@
          (only (rnrs base)
                and >= = quote * + - define begin ... let*
                quote case else values apply let cond if >
-               <= expt assert integer? lambda for-each)
+               <= expt assert integer? lambda for-each
+               not)
          (only (rnrs control)
                unless when)
          (only (rnrs records syntactic)
@@ -95,7 +97,10 @@
              (immutable new-put-operation-trigger
                         server-new-put-operation-trigger)
              ;; Atomic box holding an unsigned 64-bit integer.
-             (immutable next-unique-id/box server-next-unique-id/box)))
+             (immutable next-unique-id/box server-next-unique-id/box)
+             ;; Hash table from operation ids to their corresponding
+             ;; <get> object.
+             (immutable id->operation-map server-id->operation-map)))
 
     (define-record-type (<get> %make-get get?)
       (fields (immutable server get:server)
@@ -167,12 +172,18 @@ slice.  Call @var{found} on every search result."
       ;; TODO: options, xquery ...
       (unless (= (slice-length key) (sizeof /hashcode:512 '()))
        (error "length of key incorrect"))
+      (define id (fresh-id server))
       (define handle (%make-get server found (slice/read-only key)
-                               (fresh-id server)
+                               id
                                desired-replication-level
                                (canonical-block-type type)
                                0)) ; TODO
-      (hashq-set! (server-new-get-operations server) handle #t)
+      ;; The operation must be added to id->operation-map before adding it
+      ;; to server-new-get-operations.  Otherwise, a concurrent start-get!
+      ;; could trigger new-get-operations-trigger between the hashv-set!
+      ;; and hashq-set!, possibly causing the operation to be sent
+      (hashv-set! (server-id->operation-map server) id handle)
+      (hashq-set! (server-new-get-operations server) handle #t) ; XXX race 
condition, a condition variable is needed here, to be waited upon later
       ;; Asynchronuously process the new get request.
       (trigger-condition! (server-new-get-operation-trigger server))
       handle)
@@ -241,19 +252,23 @@ even if not connected.  This is an idempotent operation."
       (define new-get-operations (make-hash-table))
       (define new-put-operation-trigger (make-repeated-condition))
       (define new-put-operations (make-hash-table))
+      (define id->operation-map (make-hash-table))
       (reconnect new-get-operations new-get-operation-trigger
                 new-put-operations new-put-operation-trigger
                 request-close?/box request-close-condition config
+                id->operation-map
                 #:spawn spawn)
       (%make-server request-close?/box request-close-condition
                    new-get-operations new-get-operation-trigger
                    new-put-operations new-put-operation-trigger
                    ;; Any ‘small’ exact natural number will do.
-                   (make-atomic-box 0)))
+                   (make-atomic-box 0)
+                   id->operation-map))
 
     (define* (reconnect new-get-operations new-get-operation-trigger
                        new-put-operations new-put-operation-trigger
                        request-close?/box request-close-condition config
+                       id->operation-map
                        #:key (spawn spawn-fiber)
                        #:rest rest)
       (define handlers
@@ -293,7 +308,20 @@ even if not connected.  This is an idempotent operation."
           ;; Actual data follows, hence >= instead of =.
           (well-formed?/path-length slice /:msg:dht:client:result
                                     (get-path-length put-path-length) >=))
-         ((handle! slice) ???))))
+         ((handle! slice)
+          ;; The DHT service found some data we were looking for.
+          (let* ((header (slice-slice slice 0
+                                      (sizeof /:msg:dht:client:result '())))
+                 (id (read% /:msg:dht:client:result '(unique-id) header))
+                 (handle (hashv-ref id->operation-map id)))
+            (cond ((not handle)
+                   (pk 'id id)
+                   TODO-error-reporting/1)
+                  ((get? handle)
+                   ;; TODO might not be true once monitoring operations
+                   ;; are supported.
+                   (process-client-result handle slice))
+                  (#true TODO-error-reporting/2)))))))
       ;; TODO: abstract duplication in (gnu gnunet nse client)
       (define mq-closed (make-condition))
       (define (error-handler error . arguments)
@@ -308,7 +336,7 @@ even if not connected.  This is an idempotent operation."
                    new-get-operations new-get-operation-trigger
                    new-put-operations new-put-operation-trigger
                    request-close?/box request-close-condition
-                   config rest)))
+                   config id->operation-map rest)))
          ((connection:interrupted)
           (values))
          (else

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.