[gnunet-scheme] 12/49: dht/client: Send messages for new get operations.

[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 7279d5d258b608471c6343b36213a4d680b5381e
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Sep 19 15:38:43 2021 +0200

    dht/client: Send messages for new get operations.
    
    * gnu/gnunet/dht/client.scm
      (<get>)[key]: Document type
      (send-get!): New procedure.
      (start-get!): Verify length and readibility of key early.
      (reconnect): Add new arguments.
      (connect): Adjust call to reconnect.
      (reconnect)[error-handler]: Likewise.
      (reconnect)[process-new-get-operations]: New fiber.
---
 gnu/gnunet/dht/client.scm | 59 +++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 49 insertions(+), 10 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index dbbaebb..0a03ad1 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -35,13 +35,14 @@
   (import (gnu extractor enum)
          (gnu gnunet block)
          (gnu gnunet concurrency repeated-condition)
+         (gnu gnunet hashcode struct)
          (gnu gnunet mq)
          (gnu gnunet mq handler)
          (gnu gnunet mq-impl stream)
          (gnu gnunet mq envelope)
          (only (guile)
                pk define-syntax-rule define* error
-               make-hash-table hashq-set!)
+               make-hash-table hashq-set! hashq-remove! hash-map->list)
          (only (ice-9 atomic)
                make-atomic-box atomic-box-ref atomic-box-set!)
          (only (gnu extractor enum)
@@ -60,13 +61,13 @@
          (only (gnu gnunet message protocols)
                message-type)
          (only (gnu gnunet netstruct syntactic)
-               read% sizeof)
+               read% sizeof set%! select)
          (only (gnu gnunet utils bv-slice)
-               slice-length slice/read-only)
+               slice-length slice/read-only make-slice/read-write slice-copy!)
          (only (rnrs base)
                and >= = quote * + - define begin ... let*
                quote case else values apply let cond if >
-               <= expt assert integer?)
+               <= expt assert integer? lambda for-each)
          (only (rnrs control)
                unless when)
          (only (rnrs records syntactic)
@@ -92,13 +93,28 @@
     (define-record-type (<get> %make-get get?)
       (fields (immutable server get:server)
              (immutable found get:iterator)
-             (immutable key get:key)
+             (immutable key get:key) ; bytevector slice (/hashcode:512)
              (immutable unique-id get:unique-id)
              (immutable desired-replication-level
                         get:desired-replication-level)
              (immutable type get:type)
              (immutable options get:options)))
 
+    (define (send-get! mq get)
+      "Send a GET message for @var{get}."
+      (pk 'new get)
+      (define s (make-slice/read-write (sizeof /:msg:dht:client:get '())))
+      (set%! /:msg:dht:client:get '(header size) s (slice-length s))
+      (set%! /:msg:dht:client:get '(header type) s
+            (value->index (symbol-value message-type msg:dht:client:get)))
+      (set%! /:msg:dht:client:get '(options) s (get:options get))
+      (set%! /:msg:dht:client:get '(desired-replication-level) s
+            (get:desired-replication-level get))
+      (set%! /:msg:dht:client:get '(type) s (get:type get))
+      (slice-copy! (get:key get) (select /:msg:dht:client:get '(key) s))
+      (set%! /:msg:dht:client:get '(unique-id) s (get:unique-id get))
+      (send-message! mq s))
+
     (define (fresh-id server)
       "Generate a fresh numeric ID to use for communication with @var{server}."
       ;; Atomically increment the ‘next unique id’, but avoid
@@ -133,7 +149,10 @@ slice.  Call @var{found} on every search result."
              (#t
               (assert (block-type? type))
               (value->index type))))
-      (define handle (%make-get server found key (fresh-id server)
+      (unless (= (slice-length key) (sizeof /hashcode:512 '()))
+       (error "length of key incorrect"))
+      (define handle (%make-get server found (slice/read-only key)
+                               (fresh-id server)
                                desired-replication-level
                                type
                                0)) ; TODO
@@ -172,14 +191,18 @@ even if not connected.  This is an idempotent operation."
       "Connect to the DHT service in the background."
       (define request-close?/box (make-atomic-box #f))
       (define request-close-condition (make-condition))
-      (reconnect request-close?/box request-close-condition config
+      (define new-get-operation-trigger (make-repeated-condition))
+      (define new-get-operations (make-hash-table))
+      (reconnect new-get-operations new-get-operation-trigger
+                request-close?/box request-close-condition config
                 #:spawn spawn)
       (%make-server request-close?/box request-close-condition
-                   (make-hash-table) (make-repeated-condition)
+                   new-get-operations new-get-operation-trigger
                    ;; Any ‘small’ exact natural number will do.
                    (make-atomic-box 0)))
 
-    (define* (reconnect request-close?/box request-close-condition config
+    (define* (reconnect new-get-operations new-get-operation-trigger
+                       request-close?/box request-close-condition config
                        #:key (spawn spawn-fiber)
                        #:rest rest)
       (define handlers
@@ -230,7 +253,8 @@ even if not connected.  This is an idempotent operation."
          ((input:regular-end-of-file input:premature-end-of-file)
           (signal-condition! mq-closed)
           (unless (atomic-box-ref request-close?/box)
-            (apply reconnect request-close?/box request-close-condition
+            (apply reconnect new-get-operations new-get-operation-trigger
+                   request-close?/box request-close-condition
                    config rest)))
          ((connection:interrupted)
           (values))
@@ -244,8 +268,23 @@ even if not connected.  This is an idempotent operation."
          ;; Make sure the fiber exits after a reconnect.
          (wait-operation mq-closed)))
        (close-queue! mq))
+      (define (process-new-get-operations)
+       "Process newly-added get operations, that still need to be communicate
+to the DHT service."
+       (await-trigger! new-get-operation-trigger)
+       (pk 'newstuff!)
+       ;; Extract the latest new operations
+       (define new (hash-map->list (lambda (get _) get) new-get-operations))
+       ;; And remove them from the hash table
+       (for-each (lambda (get) (hashq-remove! new-get-operations get)) new)
+       ;; and (asynchronuously) sent the GET message
+       (for-each (lambda (get) (send-get! mq get)) new)
+       ;; TODO reconnection, closing queues and cancelling get operations,
+       ;; processing answers ...
+       (process-new-get-operations))
       (define mq (connect/fibers config "dht" handlers error-handler
                                 #:spawn spawn))
       (spawn request-close-handler)
+      (spawn process-new-get-operations)
       ;; TODO: use new-get-operations
       'todo)))

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