[gnunet-scheme] 01/05: dht/client: Only access 'id->operation-map' from 'control'.

[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 bc436e9bfa01463f49d13b46ef86f147cb57d197
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Feb 15 09:27:39 2022 +0000

    dht/client: Only access 'id->operation-map' from 'control'.
    
    This bypasses potential races and thread-unsafety problems.
    
    * gnu/gnunet/dht/client.scm
      (reconnect)[request-search-result-iterator]: New procedure.
      (reconnect)[handlers]<msg:dht:client:result>: Use new procedure
      instead of 'id->operation-map'.
      (reconnect)[request-search-result-iterator]: New case.
---
 gnu/gnunet/dht/client.scm | 33 +++++++++++++++++++++++++++++----
 1 file changed, 29 insertions(+), 4 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 395c5ae..a26022f 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -91,9 +91,9 @@
          (only (fibers conditions)
                make-condition signal-condition! wait-operation wait)
          (only (fibers operations)
-               perform-operation choice-operation)
+               perform-operation choice-operation wrap-operation)
          (only (fibers channels)
-               make-channel put-operation get-operation)
+               make-channel put-operation get-operation get-message 
put-message)
          (only (gnu gnunet mq error-reporting)
                report-error)
          (gnu gnunet dht struct)
@@ -111,7 +111,8 @@
                and >= = quote * / + - define begin ... let*
                quote case else values apply let cond if >
                <= expt assert exact? integer? lambda for-each
-               not expt min max div-and-mod positive? define-syntax)
+               not expt min max div-and-mod positive? define-syntax
+               vector)
          (only (rnrs control)
                unless when)
          (only (rnrs records syntactic)
@@ -749,6 +750,25 @@ code automatically tries to reconnect, so @var{connected} 
can be called after
                        #:key (spawn spawn-fiber)
                        connected disconnected
                        #:rest rest)
+      (define (request-search-result-iterator unique-id)
+       "Ask @code{control} what is the iterator for the get operation with
+unique id @var{unique-id}.  If there is no such get operation, or the get
+operation is cancelled, return @code{#false} instead."
+       ;; It is possible to look at id->operation-map directly instead,
+       ;; but hash tables are thread-unsafe.
+       ;; TODO: reduce allocations
+       (define response-channel (make-channel))
+       (perform-operation
+        (choice-operation
+         ;; TODO: is this case needed?
+         (wrap-operation (wait-operation terminal-condition)
+                         (lambda () #false))
+         (wrap-operation
+          (put-operation control-channel
+                         (vector 'request-search-result-iterator unique-id
+                                 response-channel))
+          (lambda ()
+            (get-message response-channel))))))
       (define handlers
        (message-handlers
         (message-handler
@@ -791,7 +811,7 @@ code automatically tries to reconnect, so @var{connected} 
can be called after
           (let^ ((<-- (search-result unique-id)
                       ;; TODO: maybe verify the type and key?
                       (analyse-client-result slice))
-                 (! handle (hashv-ref id->operation-map unique-id))
+                 (! handle (request-search-result-iterator unique-id))
                  (? (not handle)
                     ;; Where did this unique id come from?
                     (pk 'unique-id unique-id)
@@ -886,6 +906,11 @@ code automatically tries to reconnect, so @var{connected} 
can be called after
           ;; Send the put operation to the DHT service.
           (send-message! mq (put:message put))
           ;; Continue!
+          (control))
+         ;; Send by @code{request-search-result-iterator}.
+         (#('request-search-result-iterator unique-id response-channel)
+          (put-message response-channel (hashv-ref id->operation-map 
unique-id))
+          ;; Continue!
           (control))))
       ;; Start the main event loop.
       (spawn control))))

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