[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 01/02: dht/client: Extract question-response code.
From: |
gnunet |
Subject: |
[gnunet-scheme] 01/02: dht/client: Extract question-response code. |
Date: |
Thu, 18 Aug 2022 12:44:54 +0200 |
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 3110dd7b23872e87d5146ed9b5ab6862295f4cbb
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Aug 18 12:34:14 2022 +0200
dht/client: Extract question-response code.
It will be useful for cadet/client.
* gnu/gnunet/dht/client.scm (reconnect)[request-search-result-iterator]:
Extract some code to ...
* gnu/gnunet/server.scm (maybe-ask*): ... this new procedure, and ...
* gnu/gnunet/dht/client.scm
(reconnect)[control*]{request-search-result-iterator}:
... extract some code to ...
* gnu/gnunet/server.scm (answer): ... this new procedure.
---
gnu/gnunet/dht/client.scm | 22 +++++++++-------------
gnu/gnunet/server.scm | 22 ++++++++++++++++++++--
2 files changed, 29 insertions(+), 15 deletions(-)
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 1c6a479..55ba62a 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -80,7 +80,7 @@
(gnu gnunet mq envelope)
(only (gnu gnunet server)
maybe-send-control-message! maybe-send-control-message!*
- make-error-handler
+ make-error-handler maybe-ask* answer
<server> server-terminal-condition server-control-channel
make-disconnect! handle-control-message!)
(only (guile)
@@ -103,7 +103,7 @@
(only (fibers operations)
perform-operation choice-operation wrap-operation)
(only (fibers channels)
- make-channel put-operation get-operation get-message
put-message)
+ put-operation get-operation put-message)
(only (gnu gnunet concurrency lost-and-found)
make-lost-and-found collect-lost-and-found-operation
losable-lost-and-found)
@@ -797,14 +797,10 @@ 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))
;; TODO: is the 'terminal-condition' case needed?
- (and (maybe-send-control-message!* terminal-condition control-channel
- 'request-search-result-iterator
- unique-id
- response-channel)
- (get-message response-channel)))
+ (maybe-ask* terminal-condition control-channel
+ 'request-search-result-iterator
+ unique-id))
(define handlers
(message-handlers
(message-handler
@@ -906,10 +902,10 @@ operation is cancelled, return @code{#false} instead."
;; Continue!
(control))
;; Send by @code{request-search-result-iterator}.
- (('request-search-result-iterator unique-id response-channel)
- (put-message response-channel
- (and=> (hashv-ref id->operation-map unique-id)
- dereference))
+ (('request-search-result-iterator answer-box unique-id)
+ (answer answer-box
+ (and=> (hashv-ref id->operation-map unique-id)
+ dereference))
;; Continue!
(control))
(('resend-old-operations!)
diff --git a/gnu/gnunet/server.scm b/gnu/gnunet/server.scm
index 0c60dab..ca1b1e2 100644
--- a/gnu/gnunet/server.scm
+++ b/gnu/gnunet/server.scm
@@ -19,19 +19,20 @@
;; TODO: document
(define-library (gnu gnunet server)
(export maybe-send-control-message!* maybe-send-control-message!
+ maybe-ask* answer
make-error-handler
<server> server-terminal-condition server-control-channel
make-disconnect!
handle-control-message!)
(import (only (rnrs base)
begin define case else apply values quote lambda
- if error list)
+ if error list let and)
(only (rnrs records syntactic)
define-record-type)
(only (fibers conditions)
make-condition wait-operation signal-condition!)
(only (fibers channels)
- make-channel put-operation)
+ make-channel put-operation put-message get-message)
(only (fibers operations)
choice-operation perform-operation wrap-operation)
(only (gnu gnunet concurrency lost-and-found)
@@ -74,6 +75,23 @@ values are the same as for
@code{maybe-send-control-message!*}."
(apply maybe-send-control-message!* (server-terminal-condition server)
(server-control-channel server) message))
+ (define (maybe-ask* terminal-condition control-channel question . rest)
+ "Maybe-send a list @code{(question answer-box . rest)} to the control
channel of
+the server. The control channel should put an answer in the answer box with
+@code{answer}, when done so, the response value is returned. In case of a
permanent
+disconnect, @code{#false} is returned.
+
+The type of @var{answer-box} is an implementation detail."
+ (let ((response-channel (make-channel)))
+ (and (apply maybe-send-control-message!* terminal-condition
+ control-channel question response-channel rest)
+ (get-message response-channel))))
+
+ (define (answer answer-box answer)
+ "The counterpart of @code{maybe-ask*}."
+ (put-message answer-box answer)
+ (values)) ; for backtraces, if the type of @var{answer-box} is incorrect
+
(define (make-error-handler connected disconnected terminal-condition
control-channel)
(define (error-handler key . arguments)
(case key
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.