[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] branch master updated (7f6e421 -> f383c72)
|
From: |
gnunet |
|
Subject: |
[gnunet-scheme] branch master updated (7f6e421 -> f383c72) |
|
Date: |
Fri, 11 Feb 2022 20:38:09 +0100 |
This is an automated email from the git hooks/post-receive script.
maxime-devos pushed a change to branch master
in repository gnunet-scheme.
from 7f6e421 concurrency/lost-and-found: New module.
new 81447e9 Make uses of 'set%!' less verbose.
new 5c65eec dht/struct: Correct field name.
new f383c72 dht/client: New analysis and construction procedures.
The 3 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails. The revisions
listed as "add" were already present in the repository and have only
been added to this reference.
Summary of changes:
Makefile.am | 1 +
doc/distributed-hash-table.tm | 11 +++
gnu/gnunet/dht/client.scm | 89 ++++++++++++++--------
gnu/gnunet/dht/network.scm | 2 +
gnu/gnunet/dht/struct.scm | 2 +-
.../{dht/network.scm => utils/cut-syntax.scm} | 31 +++++---
tests/mq.scm | 26 ++++---
tests/network-size.scm | 21 +++--
8 files changed, 116 insertions(+), 67 deletions(-)
copy gnu/gnunet/{dht/network.scm => utils/cut-syntax.scm} (51%)
diff --git a/Makefile.am b/Makefile.am
index b42b6cc..dc4b207 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -60,6 +60,7 @@ modules = \
\
gnu/gnunet/utils/bv-slice.scm \
gnu/gnunet/utils/hat-let.scm \
+ gnu/gnunet/utils/cut-syntax.scm \
gnu/gnunet/utils/netstruct.scm \
gnu/gnunet/utils/platform-enum.scm \
gnu/gnunet/utils/tokeniser.scm \
diff --git a/doc/distributed-hash-table.tm b/doc/distributed-hash-table.tm
index b9f25fe..46eb5db 100644
--- a/doc/distributed-hash-table.tm
+++ b/doc/distributed-hash-table.tm
@@ -209,6 +209,12 @@
\<#2018\>unique id\<#2019\> and <var|options> as options.
</explain>
+ <\explain>
+ <scm|(construct-client-get-stop <var|key>
+ <var|unique-id>)><index|construct-client-get-stop>
+ </explain|Create a new <scm|/:msg:dht:client:get:stop> message for
+ cancelling a get request.>
+
<\explain>
<scm|(construct-client-put <var|insertion> #:optional (options
0))><index|construct-client-put>
@@ -235,6 +241,11 @@
<var|message>. Xqueries are currently unsupported.
</explain>
+ <\explain>
+ <scm|(analyse-client-get-stop
<var|message>)><index|analyse-client-get-stop>
+ </explain|Return the unique id and the key corresponding to the
+ <scm|/:msg:dht:client:stop> message <var|message>.>
+
<\explain>
<scm|(analyse-client-put <var|message>)><index|analyse-client-put>
<|explain>
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 95aedc8..2520bf6 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -51,9 +51,11 @@
;; Network message manipulation procedures
;; (these belong to (gnu gnunet dht network)).
(rename (construct-client-get #{ construct-client-get}#)
+ (construct-client-get-stop #{ construct-client-get-stop}#)
(construct-client-put #{ construct-client-put}#)
(construct-client-result #{ construct-client-result}#)
(analyse-client-get #{ analyse-client-get}#)
+ (analyse-client-get-stop #{ analyse-client-get-stop}#)
(analyse-client-put #{ analyse-client-put}#)
(analyse-client-result #{ analyse-client-result}#))
@@ -103,11 +105,13 @@
slice-length slice/read-only make-slice/read-write slice-copy!
slice-slice verify-slice-readable)
(gnu gnunet utils hat-let)
+ (only (gnu gnunet utils cut-syntax)
+ cut-syntax)
(only (rnrs base)
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?)
+ not expt min max div-and-mod positive? define-syntax)
(only (rnrs control)
unless when)
(only (rnrs records syntactic)
@@ -399,15 +403,31 @@ slices in @var{old} do not impact the new search result."
"Create a new @code{/:msg:dht:client:get} message for the query object
@var{query}, with @var{unique-id} as ‘unique id’ and @var{options} as
options."
(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 options)
- (set%! /:msg:dht:client:get '(desired-replication-level) s
- (query-desired-replication-level query))
- (set%! /:msg:dht:client:get '(type) s (query-type query))
+ (define-syntax set%!/get (cut-syntax set%! /:msg:dht:client:get <> s <>))
+ (set%!/get '(header size) (slice-length s))
+ (set%!/get '(header type)
+ (value->index (symbol-value message-type msg:dht:client:get)))
+ (set%!/get '(options) options)
+ (set%!/get '(desired-replication-level)
+ (query-desired-replication-level query))
+ (set%!/get '(type) (query-type query))
(slice-copy! (query-key query) (select /:msg:dht:client:get '(key) s))
- (set%! /:msg:dht:client:get '(unique-id) s unique-id)
+ (set%!/get '(unique-id) unique-id)
+ s)
+
+ (define* (construct-client-get-stop key unique-id)
+ "Create a new @code{/:msg:dht:client:get:stop} message for cancelling a
+get request with @var{unique-id} as unique id and @var{key} as key."
+ (define s (make-slice/read-write (sizeof /:msg:dht:client:get:stop '())))
+ (define-syntax set%!/stop
+ (cut-syntax set%! /:msg:dht:client:get:stop <> s <>))
+ (set%!/stop '(header size) (slice-length s))
+ (set%!/stop '(header type)
+ (value->index
+ (symbol-value message-type msg:dht:client:get:stop)))
+ (set%!/stop '(reserved) 0)
+ (set%!/stop '(unique-id) unique-id)
+ (slice-copy! key (select /:msg:dht:client:get:stop '(key) s))
s)
(define* (construct-client-put insertion #:optional (options 0))
@@ -421,17 +441,17 @@ object insertion with @var{options} as options."
(+ size/header (slice-length (datum-value datum)))))
(define header (slice-slice message 0 size/header))
(define rest (slice-slice message size/header))
- (set%! /:msg:dht:client:put '(header type) header
- (value->index (symbol-value message-type msg:dht:client:put)))
- (set%! /:msg:dht:client:put '(header size) header size)
- (set%! /:msg:dht:client:put '(type) header (datum-type datum))
- (set%! /:msg:dht:client:put '(option) header options)
- (set%! /:msg:dht:client:put '(desired-replication-level) header
- (insertion-desired-replication-level insertion))
- (set%! /:msg:dht:client:put '(expiration) header (datum-expiration
datum))
+ (define-syntax set%!/put (cut-syntax set%! /:msg:dht:client:put <>
header <>))
+ (set%!/put '(header type)
+ (value->index (symbol-value message-type msg:dht:client:put)))
+ (set%!/put '(header size) size)
+ (set%!/put '(type) (datum-type datum))
+ (set%!/put '(option) options)
+ (set%!/put '(desired-replication-level)
+ (insertion-desired-replication-level insertion))
+ (set%!/put '(expiration) (datum-expiration datum))
;; Copy key-data pair to insert into the DHT.
- (slice-copy! (datum-key datum)
- (select /:msg:dht:client:put '(key) header))
+ (slice-copy! (datum-key datum) (select /:msg:dht:client:put '(key)
header))
(slice-copy! (datum-value datum) rest)
message)
@@ -459,20 +479,17 @@ result object @var{search-result}, with @var{unique-id}
as ‘unique id’"
(! message (make-slice/read-write size))
(! header (slice-slice message 0 size/header))
(! rest (slice-slice message size/header)))
- (set%! /:msg:dht:client:result '(header type)
- header
- (value->index
- (symbol-value message-type msg:dht:client:result)))
- (set%! /:msg:dht:client:result '(header size)
- header
- size)
- (set%! /:msg:dht:client:result '(type) header type)
- (set%! /:msg:dht:client:result '(get-path-length)
- header get-path-length)
- (set%! /:msg:dht:client:result '(put-path-length)
- header put-path-length)
- (set%! /:msg:dht:client:result '(unique-id) header unique-id)
- (set%! /:msg:dht:client:result '(expiration) header expiration)
+ (define-syntax set%!/result
+ (cut-syntax set%! /:msg:dht:client:result <> header <>))
+ (set%!/result '(header type)
+ (value->index
+ (symbol-value message-type msg:dht:client:result)))
+ (set%!/result '(header size) size)
+ (set%!/result '(type) type)
+ (set%!/result '(get-path-length) get-path-length)
+ (set%!/result '(put-path-length) put-path-length)
+ (set%!/result '(unique-id) unique-id)
+ (set%!/result '(expiration) expiration)
(slice-copy! key (select /:msg:dht:client:result '(key) header))
;; TODO: get-path and put path!
(slice-copy! value rest)
@@ -493,6 +510,12 @@ currently unsupported."
desired-replication-level)))
(values query unique-id options)))
+ (define (analyse-client-get-stop message)
+ "Return the unique id and the key corresponding to the
+@code{/:msg:dht:client:stop} message @var{message}."
+ (values (read% /:msg:dht:client:get:stop '(unique-id) message)
+ (select /:msg:dht:client:get:stop '(key) message)))
+
(define (analyse-client-put message)
"Return the insertion object and options corresponding to the
@code{/:msg:dht:client:put} message @var{message}."
diff --git a/gnu/gnunet/dht/network.scm b/gnu/gnunet/dht/network.scm
index 6dd4129..79b16fe 100644
--- a/gnu/gnunet/dht/network.scm
+++ b/gnu/gnunet/dht/network.scm
@@ -20,8 +20,10 @@
analyse-client-get analyse-client-put analyse-client-result)
(import (rename (gnu gnunet dht client)
(#{ construct-client-get}# construct-client-get)
+ (#{ construct-client-get-stop}# construct-client-get-stop)
(#{ construct-client-put}# construct-client-put)
(#{ construct-client-result}# construct-client-result)
(#{ analyse-client-get}# analyse-client-get)
+ (#{ analyse-client-get-stop}# analyse-client-get-stop)
(#{ analyse-client-put}# analyse-client-put)
(#{ analyse-client-result}# analyse-client-result))))
diff --git a/gnu/gnunet/dht/struct.scm b/gnu/gnunet/dht/struct.scm
index 98788f7..529d68f 100644
--- a/gnu/gnunet/dht/struct.scm
+++ b/gnu/gnunet/dht/struct.scm
@@ -73,7 +73,7 @@ and discard any state.")
(synopsis "Type: msg:dht:client:get:stop"))
(field (reserved u32/big)
(synopsis "Always zero"))
- (field (reserved u64/big)
+ (field (unique-id u64/big)
(synopsis "Unique ID identifying this request"))
(field (key /hashcode:512)
(synopsis "Key of this request"))))
diff --git a/gnu/gnunet/dht/network.scm b/gnu/gnunet/utils/cut-syntax.scm
similarity index 51%
copy from gnu/gnunet/dht/network.scm
copy to gnu/gnunet/utils/cut-syntax.scm
index 6dd4129..bc4ee9d 100644
--- a/gnu/gnunet/dht/network.scm
+++ b/gnu/gnunet/utils/cut-syntax.scm
@@ -15,13 +15,24 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL-3.0-or-later
-(define-library (gnu gnunet dht network)
- (export construct-client-get construct-client-put construct-client-result
- analyse-client-get analyse-client-put analyse-client-result)
- (import (rename (gnu gnunet dht client)
- (#{ construct-client-get}# construct-client-get)
- (#{ construct-client-put}# construct-client-put)
- (#{ construct-client-result}# construct-client-result)
- (#{ analyse-client-get}# analyse-client-get)
- (#{ analyse-client-put}# analyse-client-put)
- (#{ analyse-client-result}# analyse-client-result))))
+
+;; TODO: eliminate (gnu gnunet netstruct syntactic), use a compiler pass
instead
+;; for inlining, then ‘cut-syntax’ can be deprecated in favour of a ‘cut’.
+(define-library (gnu gnunet utils cut-syntax)
+ (export cut-syntax)
+ (import (only (rnrs base) ... begin define-syntax syntax-rules))
+ (begin
+ (define-syntax substitute
+ (syntax-rules (<>)
+ ((_ (substituted ...) (<> . foos) (bar . bars))
+ (substitute (substituted ... bar) foos bars))
+ ((_ (substituted ...) (foo . foos) bars)
+ (substitute (substituted ... foo) foos bars))
+ ((_ (substituted ...) () ())
+ (substituted ...))))
+
+ (define-syntax cut-syntax
+ (syntax-rules ()
+ ((_ . foos)
+ (syntax-rules ()
+ ((_ . bars) (substitute () foos bars))))))))
diff --git a/tests/mq.scm b/tests/mq.scm
index 14d2a27..8d456ac 100644
--- a/tests/mq.scm
+++ b/tests/mq.scm
@@ -1,5 +1,5 @@
;; This file is part of GNUnet.
-;; Copyright (C) 2012, 2018, 2021 GNUnet e.V.
+;; Copyright (C) 2012, 2018, 2021, 2022 GNUnet e.V.
;;
;; GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
@@ -46,6 +46,7 @@
(gnu gnunet util struct)
(gnu gnunet utils bv-slice)
(gnu gnunet utils hat-let)
+ (gnu gnunet utils cut-syntax)
((gnu extractor enum)
#:select (symbol-value value->index))
(gnu gnunet message protocols)
@@ -82,11 +83,11 @@ Then each time the index is increased.")
(define (index->dummy i)
(let ((s (make-slice/read-write
(sizeof /:msg:our-test:dummy '()))))
- (set%! /:msg:our-test:dummy '(header type) s
- (value->index (symbol-value message-type msg:util:dummy)))
- (set%! /:msg:our-test:dummy '(header size) s
- (sizeof /:msg:our-test:dummy '()))
- (set%! /:msg:our-test:dummy '(index) s i)
+ (define-syntax set%!/dummy (cut-syntax set%! /:msg:our-test:dummy <> s <>))
+ (set%!/dummy '(header type)
+ (value->index (symbol-value message-type msg:util:dummy)))
+ (set%!/dummy '(header size) (sizeof /:msg:our-test:dummy '()))
+ (set%!/dummy '(index) i)
s))
(define (dummy->index s)
@@ -341,12 +342,13 @@ Then each time the index is increased.")
(define (make-thread-message thread-index i)
(let ((s (make-slice/read-write
(sizeof /:msg:our-test:concurrency '()))))
- (set%! /:msg:our-test:concurrency '(header type) s
- (value->index (symbol-value message-type msg:util:dummy)))
- (set%! /:msg:our-test:concurrency '(header size) s
- (sizeof /:msg:our-test:concurrency '()))
- (set%! /:msg:our-test:concurrency '(index) s i)
- (set%! /:msg:our-test:concurrency '(thread) s thread-index)
+ (define-syntax set%!/concurrency
+ (cut-syntax set%! /:msg:our-test:concurrency <> s <>))
+ (set%!/concurrency
+ '(header type) (value->index (symbol-value message-type msg:util:dummy)))
+ (set%!/concurrency '(header size) (sizeof /:msg:our-test:concurrency '()))
+ (set%!/concurrency '(index) i)
+ (set%!/concurrency '(thread) thread-index)
s))
(define (decode-thread-message s)
diff --git a/tests/network-size.scm b/tests/network-size.scm
index 0b27d29..8f8e6bb 100644
--- a/tests/network-size.scm
+++ b/tests/network-size.scm
@@ -23,6 +23,7 @@
(gnu extractor enum)
(gnu gnunet message protocols)
(gnu gnunet config db)
+ (gnu gnunet utils cut-syntax)
(only (rnrs base)
assert)
(prefix (gnu gnunet nse client) #{nse:}#)
@@ -103,19 +104,17 @@
(define (send! estimate)
(define s (make-slice/read-write
(sizeof /:msg:nse:estimate '())))
+ (define-syntax set%!/estimate
+ (cut-syntax set%! /:msg:nse:estimate <> s <>))
;; Set the headers
- (set%! /:msg:nse:estimate '(header size) s
- (sizeof /:msg:nse:estimate '()))
- (set%! /:msg:nse:estimate '(header type) s
- (value->index
- (symbol-value message-type msg:nse:estimate)))
+ (set%!/estimate '(header size) (sizeof /:msg:nse:estimate '()))
+ (set%!/estimate '(header type)
+ (value->index
+ (symbol-value message-type msg:nse:estimate)))
;; Set the data
- (set%! /:msg:nse:estimate '(timestamp) s
- (list-ref estimate 3))
- (set%! /:msg:nse:estimate '(size-estimate) s
- (list-ref estimate 0))
- (set%! /:msg:nse:estimate '(std-deviation) s
- (list-ref estimate 2))
+ (set%!/estimate '(timestamp) (list-ref estimate 3))
+ (set%!/estimate '(size-estimate) (list-ref estimate 0))
+ (set%!/estimate '(std-deviation) (list-ref estimate 2))
;; Send the estimate
(send-message! mq s))
(for-each send! %estimates))
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] branch master updated (7f6e421 -> f383c72),
gnunet <=