Add client

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)]))

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)