Add client
This commit is contained in:
parent
9b377586e5
commit
bf77598fad
|
@ -0,0 +1,109 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require racket/match)
|
||||||
|
(require racket/tcp)
|
||||||
|
(require racket/cmdline)
|
||||||
|
(require logbook)
|
||||||
|
|
||||||
|
(define server-entry-name #f)
|
||||||
|
|
||||||
|
(command-line #:program "echo-client.rkt"
|
||||||
|
#:once-each
|
||||||
|
["--logbook-entry-name" name
|
||||||
|
"set logbook entry name to use when recording run statistics"
|
||||||
|
(set! server-entry-name name)])
|
||||||
|
|
||||||
|
(define L (default-logbook))
|
||||||
|
(define E (standard-logbook-entry L "minimart" "external-latency" #:name server-entry-name))
|
||||||
|
(define Tgrowth (logbook-table E "client-grow-times" #:column-spec '(initial-count
|
||||||
|
secs/connection
|
||||||
|
connections/sec
|
||||||
|
elapsed-sec
|
||||||
|
final-count)))
|
||||||
|
(define Tping (logbook-table E "client-ping-times" #:column-spec '(connection-count
|
||||||
|
secs/roundtrip
|
||||||
|
roundtrips/sec
|
||||||
|
roundtrip-count
|
||||||
|
run-duration-sec)))
|
||||||
|
|
||||||
|
;; We work our way through these waypoints: start with one connection,
|
||||||
|
;; then 10, then 20, etc etc until we reach the end.
|
||||||
|
(define waypoints
|
||||||
|
(list 1 10 20 30 40 50 60 70 80 90 100 120
|
||||||
|
150 200 210 220 230 240 250 260 270 280 290 300 400
|
||||||
|
500 600 700 800 900))
|
||||||
|
|
||||||
|
;; We exchange pings with the server for this many milliseconds before
|
||||||
|
;; moving up to the next waypoint.
|
||||||
|
(define ping-time 5000)
|
||||||
|
|
||||||
|
;; The ports representing a single connection.
|
||||||
|
(struct c (in out) #:transparent)
|
||||||
|
|
||||||
|
(define next-connection-id 0)
|
||||||
|
(define connections (hash))
|
||||||
|
|
||||||
|
;; Current number of open connections.
|
||||||
|
(define (connection-count)
|
||||||
|
(hash-count connections))
|
||||||
|
|
||||||
|
;; Ping a connection.
|
||||||
|
(define (ping-connection n)
|
||||||
|
(match-define (c in out) (hash-ref connections n))
|
||||||
|
(display "ping\n" out)
|
||||||
|
(flush-output out)
|
||||||
|
(define reply (read-line in 'any))
|
||||||
|
(when (not (equal? reply "ping"))
|
||||||
|
(error 'ping-connection "Bogus reply ~v from connection ~a" reply n)))
|
||||||
|
|
||||||
|
;; Choose a connection at random, and ping it.
|
||||||
|
(define (ping-one-at-random)
|
||||||
|
(ping-connection (random (connection-count))))
|
||||||
|
|
||||||
|
;; Start one connection.
|
||||||
|
(define (start-connection)
|
||||||
|
(define i next-connection-id)
|
||||||
|
(set! next-connection-id (+ i 1))
|
||||||
|
(define-values (in out) (tcp-connect "localhost" 5999))
|
||||||
|
(set! connections (hash-set connections i (c in out))))
|
||||||
|
|
||||||
|
;; Ping random connections for ping-time milliseconds.
|
||||||
|
(define (ping-randomly)
|
||||||
|
(define start-time (current-inexact-milliseconds))
|
||||||
|
(let loop ((count 0))
|
||||||
|
(ping-one-at-random)
|
||||||
|
(define now (current-inexact-milliseconds))
|
||||||
|
(if (< now (+ start-time ping-time))
|
||||||
|
(loop (+ count 1))
|
||||||
|
(let* ((elapsed-sec (/ (- now start-time) 1000.0))
|
||||||
|
(roundtrip-latency (/ elapsed-sec count)))
|
||||||
|
(write-logbook-datum! Tping (list (connection-count)
|
||||||
|
roundtrip-latency
|
||||||
|
(/ 1.0 roundtrip-latency)
|
||||||
|
count
|
||||||
|
elapsed-sec))))))
|
||||||
|
|
||||||
|
;; Add connections until we hit the given waypoint.
|
||||||
|
(define (grow-to-waypoint waypoint)
|
||||||
|
(define old-count (connection-count))
|
||||||
|
(define start-time (current-inexact-milliseconds))
|
||||||
|
(let loop ()
|
||||||
|
(when (< (connection-count) waypoint)
|
||||||
|
(start-connection)
|
||||||
|
(loop)))
|
||||||
|
(ping-connection (- waypoint 1)) ;; make sure the newest connection is really live.
|
||||||
|
(define grow-complete-time (current-inexact-milliseconds))
|
||||||
|
(define elapsed-sec (/ (- grow-complete-time start-time) 1000.0))
|
||||||
|
(write-logbook-datum! Tgrowth (list old-count
|
||||||
|
(/ (- waypoint old-count) elapsed-sec)
|
||||||
|
(/ elapsed-sec (- waypoint old-count))
|
||||||
|
elapsed-sec
|
||||||
|
waypoint)))
|
||||||
|
|
||||||
|
(let loop ((remaining-waypoints waypoints))
|
||||||
|
(match remaining-waypoints
|
||||||
|
['() (void)]
|
||||||
|
[(cons next-waypoint rest)
|
||||||
|
(grow-to-waypoint next-waypoint)
|
||||||
|
(ping-randomly)
|
||||||
|
(loop rest)]))
|
|
@ -23,6 +23,8 @@
|
||||||
|
|
||||||
(define connection-count 0)
|
(define connection-count 0)
|
||||||
|
|
||||||
|
(define statistics-poll-interval 2000)
|
||||||
|
|
||||||
(define (statistician)
|
(define (statistician)
|
||||||
(list (spawn (lambda (e s)
|
(list (spawn (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
|
@ -32,11 +34,12 @@
|
||||||
;; (collect-garbage)
|
;; (collect-garbage)
|
||||||
(write-logbook-datum! Tmem (list (/ now 1000.0) (current-memory-use)))
|
(write-logbook-datum! Tmem (list (/ now 1000.0) (current-memory-use)))
|
||||||
(write-logbook-datum! Tconn (list (/ now 1000.0) connection-count))
|
(write-logbook-datum! Tconn (list (/ now 1000.0) connection-count))
|
||||||
(transition s (send (set-timer 'statistician 10000 'relative)))]
|
(transition s
|
||||||
|
(send (set-timer 'statistician statistics-poll-interval 'relative)))]
|
||||||
[_ #f]))
|
[_ #f]))
|
||||||
#f
|
#f
|
||||||
(list (sub (timer-expired 'statistician ?))))
|
(list (sub (timer-expired 'statistician ?))))
|
||||||
(send (set-timer 'statistician 10000 'relative))))
|
(send (set-timer 'statistician statistics-poll-interval 'relative))))
|
||||||
|
|
||||||
(define (listener port-number)
|
(define (listener port-number)
|
||||||
(spawn (lambda (e s)
|
(spawn (lambda (e s)
|
||||||
|
|
Loading…
Reference in New Issue