[gnunet-scheme] 02/04: dht/client: Put weak references in id->operation-map.

[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 9eba8c6bd1ad6428f09eb84bc6bd80a130af3f34
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Feb 16 20:49:39 2022 +0000

    dht/client: Put weak references in id->operation-map.
    
    * gnu/gnunet/dht/client.scm
      (<get>)[get:linger?]: New field.
      (start-get!): Add 'linger?' argument.
      (make-weak-reference,make-strong-reference,dereference): New
      procedures.
      (reconnect)[id->operation-map]: Add comment about weakness.
      (reconnect)[handlers]<msg:dht:client:result>: Handle the case where
      no 'found' procedure is available.
      (reconnect)[control]<start-get!>: Wrap the search object in a weak
      reference when not lingering.
      (reconnect)[control]request-search-result-iterator]: Dereference the
      weak reference, if any.
      (reconnect)[control]<resend-old-operations!>: Dereference the weak
      reference, if any.  Handle the case where the weak reference broke.
    * doc/distributed-hash-table.scm (start-get!): Document the new
      'linger?' argument.
---
 doc/distributed-hash-table.tm | 12 +++++-
 gnu/gnunet/dht/client.scm     | 85 ++++++++++++++++++++++++++++++++++---------
 2 files changed, 79 insertions(+), 18 deletions(-)

diff --git a/doc/distributed-hash-table.tm b/doc/distributed-hash-table.tm
index 784c804..b5b41f0 100644
--- a/doc/distributed-hash-table.tm
+++ b/doc/distributed-hash-table.tm
@@ -136,7 +136,8 @@
   used.<index|searching the DHT><index|inserting data into the DHT>
 
   <\explain>
-    <scm|(start-get! <var|server> <var|query> <var|found>)><index|start-get!>
+    <scm|(start-get! <var|server> <var|query> <var|found>
+    <var|#:linger?>=#true)><index|start-get!>
   <|explain>
     Search for data matching <var|query> in the DHT. When a datum is found,
     call the unary procedure <var|found> on the search result. It is possible
@@ -154,6 +155,15 @@
     internal buffers for the slices passed to <var|found>, which could be
     overwritten after the call to <var|found>. As such, it might be necessary
     to make a copy of the search result, using <scm|copy-search-result>.
+
+    When the boolean <var|linger?> is false, the search is automatically
+    cancelled when the search object becomes unreachable according to the GC.
+    <todo|actually implement this>
+
+    <\warning>
+      Guile currently (3.0.8) uses a conservative GC, so it cannot always
+      detect unreachability when it should.
+    </warning>
   </explain>
 
   <\explain>
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 4ebaaa1..23f1d8d 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -79,11 +79,14 @@
          (only (guile)
                pk define-syntax-rule define* lambda* error
                make-hash-table hashq-set! hashq-remove! hashv-set! hashv-ref
-               hashv-remove! hash-clear! hash-map->list)
+               hashv-remove! hash-clear! hash-map->list
+               ->bool and=>)
          (only (ice-9 atomic)
                make-atomic-box atomic-box-ref atomic-box-set!)
          (only (ice-9 match)
                match)
+         (only (ice-9 weak-vector)
+               weak-vector weak-vector-ref weak-vector?)
          (only (gnu extractor enum)
                symbol-value)
          (only (fibers)
@@ -109,7 +112,7 @@
                cut-syntax)
          (only (rnrs base)
                and >= = quote * / + - define begin ... let*
-               quote case else values apply let cond if >
+               quote case else values apply let cond if > eq?
                <= expt assert exact? integer? lambda for-each
                not expt min max div-and-mod positive? define-syntax
                vector)
@@ -603,7 +606,17 @@ do anything if @var{server} has been permanently 
disconnected."
              (immutable found get:iterator) ; procedure accepting 
<search-result>
              (immutable query get:query) ; <query>
              (immutable unique-id get:unique-id)
-             (immutable options get:options)))
+             (immutable options get:options)
+             ;; TODO: actually cancel (using (gnu gnunet concurrency
+             ;; lost-and-found))
+             ;;
+             ;; If #false, 'reconnect' does not keep a strong reference to the
+             ;; search object and 'reconnect' will automatically cancel the
+             ;; search when the search object becomes unreachable.
+             ;;
+             ;; If #true, the search will not be automatically cancelled;
+             ;; 'reconnect' keeps a strong reference.
+             (immutable linger? get:linger?))) ; boolean
 
     (define-record-type (<put> %make-put put?)
       (fields (immutable server put:server)
@@ -654,7 +667,8 @@ do anything if @var{server} has been permanently 
disconnected."
             (assert (block-type? type))
             (value->index type))))
 
-    (define* (start-get! server query found)
+    ;; TODO(tests): Disable lingering by default, test linger?=#false
+    (define* (start-get! server query found #:key (linger? #true))
       "Search for data matching query in the DHT. When a datum is found, call
 the unary procedure @var{found} on the search result. It is possible to find
 multiple data matching a query. In that case, found is called multiple times.
@@ -669,12 +683,16 @@ to a separate fiber.
 To avoid expensive copies, the implementation can choose to reuse internal
 buffers for the slices passed to @var{found}, which could be overwritten after
 the call to @var{found}. As such, it might be necessary to make a copy of the
-search result, using @lisp{copy-search-result}."
+search result, using @lisp{copy-search-result}.
+
+When the boolean @var{linger?} is false, the search is automatically
+cancelled when the search object becomes unreachable according to the GC.
+TODO: implement this behaviour!"
       ;; TODO: options, xquery ...
       (define id (fresh-id server))
-      (define handle (%make-get server found query id 0)) ; TODO: options
-      ;; TODO: send 'found', 'id' and 'options' instead of sending the handle
-      ;; that has a reference to 'server' (for guardian reasons, TODO).
+      (define options 0) ; TODO: allow setting some options
+      (when linger? (assert (eq? linger? #true)))
+      (define handle (%make-get server found query id 0 (->bool linger?)))
       (maybe-send-control-message! server 'start-get! handle)
       handle)
 
@@ -744,6 +762,17 @@ code automatically tries to reconnect, so @var{connected} 
can be called after
                    ;; Any ‘small’ exact natural number will do.
                    (make-atomic-box 0)))
 
+    ;; TODO: put in new module?
+    (define (make-weak-reference to)
+      (weak-vector to))
+    (define (make-strong-reference to)
+      (assert (not (weak-vector? to)))
+      to)
+    (define (dereference reference)
+      (if (weak-vector? reference)
+         (weak-vector-ref reference 0)
+         reference))
+
     (define* (reconnect terminal-condition config
                        old-id->operation-map control-channel
                        #:key (spawn spawn-fiber)
@@ -757,6 +786,16 @@ code automatically tries to reconnect, so @var{connected} 
can be called after
       ;;
       ;; To avoid races, 'id->operation-map' and 'old-id->operation-map'
       ;; are only accessed from 'control'.
+      ;;
+      ;; To allow cancelling operations when they become unreachable, 
operations
+      ;; are wrapped in a weak reference (unless linger? is #true).  Otherwise,
+      ;; they won't ever become unreachable.  Keep in mind that, at least in
+      ;; Guile 3.0.7, weak references are broken when the object is returned
+      ;; from the guardian (and probably earlier) -- this seems to be a
+      ;; difficult to fix bug.
+      ;;
+      ;; This code is written to support both the correct and incorrect 
behaviour
+      ;; of guardians+weak vectors.
       (define id->operation-map (make-hash-table))
       (define (request-search-result-iterator unique-id)
        "Ask @code{control} what is the iterator for the get operation with
@@ -821,9 +860,10 @@ operation is cancelled, return @code{#false} instead."
                       (analyse-client-result slice))
                  (! handle (request-search-result-iterator unique-id))
                  (? (not handle)
-                    ;; Where did this unique id come from?
-                    (pk 'unique-id unique-id)
-                    TODO-error-reporting/1)
+                    ;; Perhaps the search object became unreachable;
+                    ;; 'process-stop-search' (see next commit) will be
+                    ;; called soon to inform the DHT service.
+                    (values))
                  (? (get? handle)
                     ;; TODO might not be true once monitoring operations
                     ;; are supported.
@@ -888,7 +928,10 @@ operation is cancelled, return @code{#false} instead."
          (('start-get! get)
           ;; Register the new get operation, such that we remember
           ;; where to send responses to.
-          (hashv-set! id->operation-map (get:unique-id get) get)
+          (hashv-set! id->operation-map (get:unique-id get)
+                      ((if (get:linger? get)
+                          make-strong-reference
+                          make-weak-reference) get))
           ;; (Asynchronuously) send the GET message.
           (send-get! mq get)
           ;; Continue!
@@ -911,7 +954,9 @@ operation is cancelled, return @code{#false} instead."
           (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))
+          (put-message response-channel
+                       (and=> (hashv-ref id->operation-map unique-id)
+                              dereference))
           ;; Continue!
           (control))
          (('resend-old-operations!)
@@ -919,12 +964,18 @@ operation is cancelled, return @code{#false} instead."
           ;; again.
           ;;
           ;; TODO: restarting monitoring operations
-          (for-each (lambda (get)
-                      (hashv-set! id->operation-map (get:unique-id get) get)
-                      (send-get! mq get))
+          (for-each (lambda (reference)
+                      (define get (dereference reference))
+                      ;; If the (weak) reference is broken, that means the
+                      ;; operation is unreachable, so then there is no point
+                      ;; to resending the get operation.
+                      (when get
+                        (hashv-set! id->operation-map (get:unique-id get)
+                                    reference)
+                        (send-get! mq get)))
                     ;; XXX: @code{hash-for-each} forms a continuation barrier,
                     ;; so turn the hash table into a list before iterating.
-                    (hash-map->list (lambda (x handle) handle)
+                    (hash-map->list (lambda (x reference) reference)
                                     old-id->operation-map))
           ;; Free some memory.
           (hash-clear! old-id->operation-map)

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