diff --git a/echo-client.rkt b/echo-client.rkt new file mode 100644 index 0000000..c0777ec --- /dev/null +++ b/echo-client.rkt @@ -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)])) diff --git a/echo-server.rkt b/echo-server.rkt index 19840a6..4614e19 100644 --- a/echo-server.rkt +++ b/echo-server.rkt @@ -23,6 +23,8 @@ (define connection-count 0) +(define statistics-poll-interval 2000) + (define (statistician) (list (spawn (lambda (e s) (match e @@ -32,11 +34,12 @@ ;; (collect-garbage) (write-logbook-datum! Tmem (list (/ now 1000.0) (current-memory-use))) (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 (list (sub (timer-expired 'statistician ?)))) - (send (set-timer 'statistician 10000 'relative)))) + (send (set-timer 'statistician statistics-poll-interval 'relative)))) (define (listener port-number) (spawn (lambda (e s)