;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
;; Copyright (C) 2021 GNUnet e.V.
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see .
;;
;; SPDX-License-Identifier: AGPL-3.0-or-later
(define-module (test-network-size))
(import (gnu gnunet util time)
(gnu gnunet mq)
(gnu gnunet mq-impl stream)
(gnu gnunet mq handler)
(gnu extractor enum)
(gnu gnunet message protocols)
(gnu gnunet config db)
(only (rnrs base)
assert)
(prefix (gnu gnunet nse client) #{nse:}#)
(gnu gnunet nse struct)
(only (gnu gnunet utils bv-slice)
slice-length make-slice/read-write)
(only (tests utils) call-with-services/fibers)
(only (fibers) sleep)
(gnu gnunet netstruct syntactic)
(ice-9 match)
(ice-9 suspendable-ports)
(ice-9 control)
(prefix (rnrs hashtables) #{rnrs:}#)
(srfi srfi-1)
(srfi srfi-26)
(srfi srfi-43)
(srfi srfi-64)
(fibers conditions)
(tests utils))
(test-begin "network-size")
(define (no-error-handler . e)
(pk 'e e)
(error "no error handler"))
;; The C implementation of the service requires the client
;; to sent this message.
(test-assert "Client sends msg:nse:start"
(let* ((start-sent? #f)
(start-sent-condition (make-condition))
(server-handlers
(message-handlers
(make-message-handler
(symbol-value message-type msg:nse:start)
(lambda (p) (p))
(lambda (s)
(= (slice-length s) 4))
(lambda (slice)
(assert (not start-sent?))
(set! start-sent? #t)
(signal-condition! start-sent-condition))))))
(call-with-services/fibers
`(("nse" . ,(lambda (port spawn-fiber)
(define mq (port->message-queue port server-handlers
no-error-handler
#:spawn spawn-fiber))
(values))))
(lambda (config spawn-fiber)
(nse:connect config #:spawn spawn-fiber)
(wait start-sent-condition)
#t))))
(define %estimates
`((0. ,(expt 2.0 0.) 0. 0) ; stddev can theoretically be zero
(0. ,(expt 2.0 0.) +nan.0 0) ; see
(0. ,(expt 2.0 0.) +inf.0 0) ; likewise
(0. ,(expt 2.0 0.) 0.1 0)
(1. ,(expt 2.0 1.) 0.11 10)
(2. ,(expt 2.0 2.) 0.111 100)
(3. ,(expt 2.0 3.) 0.1111 1000)))
(define (port->nse-client-message-queue port spawn-fiber)
(define h (message-handlers
(make-message-handler
(symbol-value message-type msg:nse:start)
(lambda (p) (p))
(lambda (s) (= (slice-length s) 4))
(lambda (slice) (values)))))
(port->message-queue port h no-error-handler #:spawn spawn-fiber))
(define (act-as-the-server port spawn-fiber estimates)
(define mq
(port->nse-client-message-queue port spawn-fiber))
;; Send the client a few fake estimates.
;; This code would be incorrect if there were
;; multiple clients!
(define (send! estimate)
(define s (make-slice/read-write
(sizeof /:msg:nse:estimate '())))
;; 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 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))
;; Send the estimate
(send-message! mq s))
(for-each send! %estimates))
(define (estimate->list estimate)
"Represent ESTIMATE as a list that can be compared with equal?."
`(,(nse:estimate:logarithmic-number-peers estimate)
,(nse:estimate:number-peers estimate)
,(nse:estimate:standard-deviation estimate)
,(nse:estimate:timestamp estimate)))
(define protected-against-gc)
(test-equal "Client calls call-back (and sets estimates) in-order"
(list %estimates %estimates)
(call-with-services/fibers
`(("nse" . ,(lambda (port spawn-fiber)
;; Make sure that the GC doesn't cause buffered messages
;; to be discarded.
(set! protected-against-gc port)
(act-as-the-server port spawn-fiber %estimates))))
(lambda (config spawn-fiber)
(define estimates/update/reverse '())
(define estimates/poll/reverse '())
(define connected? #f)
(define done (make-condition))
(define (updated estimate)
(assert connected?)
(assert (nse:estimate? estimate))
(set! estimates/update/reverse
(cons (estimate->list estimate) estimates/update/reverse))
(set! estimates/poll/reverse
(cons (estimate->list (nse:estimate server))
estimates/poll/reverse))
(when (= (length estimates/update/reverse)
(length %estimates))
(signal-condition! done))
(when (> (length estimates/update/reverse)
(length %estimates))
(error "too many estimates!")))
(define (connected)
(assert (not connected?))
(set! connected? #t))
(define server
(nse:connect config #:connected connected #:updated updated
#:spawn spawn-fiber))
(wait done)
(assert connected?)
(list (reverse estimates/update/reverse)
(reverse estimates/poll/reverse)))))
;; See .
;; Only the last estimate is tested.
(test-assert "likewise, without 'updated' or 'connected' (issue 4)"
(call-with-services/fibers
`(("nse" . ,(lambda (port spawn-fiber)
(set! protected-against-gc port)
(act-as-the-server port spawn-fiber %estimates))))
(lambda (config spawn-fiber)
(define server
(nse:connect config #:spawn spawn-fiber))
(let loop ((time-delta 0))
(unless (equal? (and=> (nse:estimate server) estimate->list)
(last %estimates))
(sleep (/ time-delta time-unit:second))
(loop (standard-back-off time-delta))))
#t)))
(test-assert "notify disconnected after end-of-file, after 'connected'"
(call-with-services/fibers
`(("nse" . ,(lambda (port spawn-fiber)
(close-port port))))
(lambda (config spawn-fiber)
(define disconnected? #f)
(define connected? #f)
(define c (make-condition))
(define (connected)
(set! connected? #t))
(define (disconnected)
(assert connected?)
;; Because (gnu gnunet nse client) automatically reconnects,
;; the following commented-out assertion can be false.
#;(assert (not disconnected?))
(set! disconnected? #t)
(signal-condition! c))
(define server
(nse:connect config #:spawn spawn-fiber #:connected connected
#:disconnected disconnected))
(wait c)
;; Give (gnu gnunet nse client) a chance to (incorrectly) call
;; disconnected again.
(sleep 0.001)
#t)))
(define forever (make-condition))
(test-assert "reconnects"
(let ((n 9)
(too-many? #f)
(done (make-condition)))
(call-with-services/fibers
`(("nse" . ,(lambda (port spawn-fiber)
(if (> n 0)
(begin
(set! n (- n 1))
(close-port port))
(wait forever)))))
(lambda (config spawn-fiber)
(define disconnected? #f)
(define connected? #f)
(define connected-again (make-condition))
(define disconnect-count 0)
(define (connected)
(match (cons disconnected? connected?)
((#t . #f)
(set! disconnected? #f)
(set! connected? #t)
(when (= disconnect-count 9)
(signal-condition! connected-again))
(values))
((#t . #t) (error "impossible"))
((#f . #f)
(set! connected? #t)
(values)) ; first connect
((#f . #t) (error "doubly connected"))))
(define (disconnected)
(match (cons connected? disconnected?)
((#t . #f)
(set! connected? #f)
(set! disconnected? #t)
(set! disconnect-count (+ 1 disconnect-count))
(cond
((= disconnect-count 9)
(signal-condition! done))
((> disconnect-count 9)
(set! too-many? #t)
(error "too many disconnects")))
(values))
((#t . #t) (error "impossible"))
((#f . #f)
(error "disconnected before connecting"))
((#f . #t)
(error "doubly disconnected"))))
(define server
(nse:connect config #:spawn spawn-fiber #:connected connected
#:disconnected disconnected))
(wait done)
(assert (not too-many?))
;; We used to do (sleep 0.01) here but this was
;; (rarely) insufficient.
(wait connected-again)
(assert connected?)
#t))))
(define (make-nse-config where)
"Make a configuration where the socket location of the NSE service
is @var{where}."
(define config (hash->configuration
(rnrs:make-hashtable hash-key key=?)))
(set-value! identity config "nse" "UNIXPATH" where)
config)
(test-assert "close, not connected --> all fibers stop, no callbacks called"
(call-with-spawner/wait
(lambda (spawn)
(call-with-temporary-directory
(lambda (somewhere)
(define where (in-vicinity somewhere "sock.et"))
(define config (make-nse-config where))
(define (#{don't-call-me}# . rest)
(error "oops ~a" rest))
(define server (nse:connect config #:spawn spawn
#:connected #{don't-call-me}#
#:disconnected #{don't-call-me}#
#:updated #{don't-call-me}#))
(sleep 0.001)
(nse:disconnect! server)
(sleep 0.001)
#t)))))
(test-assert "close, connected --> all fibers stop, two callbacks called"
(call-with-spawner/wait
(lambda (spawn)
(call-with-temporary-directory
(lambda (somewhere)
(define where (in-vicinity somewhere "sock.et"))
(define config (make-nse-config where))
(define (#{don't-call-me}# . rest)
(error "oops ~a" rest))
(define connected? #f)
(define disconnected? #f)
(define connected-cond (make-condition))
(define disconnected-cond (make-condition))
(define (connected)
(assert (not connected?))
(set! connected? #t)
(signal-condition! connected-cond))
(define done (make-condition))
(define (disconnected)
(assert (not disconnected?))
(assert connected?)
(signal-condition! disconnected-cond)
(set! disconnected? #t))
(define server (nse:connect config #:spawn spawn
#:connected connected
#:disconnected disconnected
#:updated #{don't-call-me}#))
(define listening (socket AF_UNIX SOCK_STREAM 0))
(make-nonblocking! listening)
(bind listening AF_UNIX where)
(listen listening 1)
(define connection (accept listening))
(wait connected-cond)
(nse:disconnect! server)
(wait disconnected-cond)
(define old-waiter (current-read-waiter))
(sleep 0.01) ;; give the NSE client a chance to accidentally connect
(let/ec ec
(parameterize ((current-read-waiter
(lambda (p)
(if (eq? p listening)
(ec)
(old-waiter p)))))
(set! connection (accept listening))
(error "client tried to connect again")))
#t)))
;; call-with-spawner/wait is more reliable without parallelism
#:parallelism 1))
(test-end "network-size")