2014-05-04 03:58:36 +00:00
|
|
|
|
#lang racket/base
|
|
|
|
|
|
|
|
|
|
(require racket/match)
|
|
|
|
|
(require racket/tcp)
|
|
|
|
|
(require racket/cmdline)
|
|
|
|
|
(require logbook)
|
|
|
|
|
|
2014-05-04 20:37:11 +00:00
|
|
|
|
(define server-entry-name (standard-logbook-entry-name))
|
2014-05-04 21:06:45 +00:00
|
|
|
|
(define server-entry-type #f)
|
2014-05-05 15:01:39 +00:00
|
|
|
|
(define server-hostname "localhost")
|
|
|
|
|
(define server-port 5999)
|
2014-05-05 15:33:50 +00:00
|
|
|
|
(define max-waypoint 1000)
|
2014-05-04 03:58:36 +00:00
|
|
|
|
|
|
|
|
|
(command-line #:program "echo-client.rkt"
|
|
|
|
|
#:once-each
|
2014-05-05 15:33:50 +00:00
|
|
|
|
["--max-waypoint" n
|
|
|
|
|
"set maximum waypoint for this run"
|
|
|
|
|
(set! max-waypoint (string->number n))]
|
2014-05-05 15:01:39 +00:00
|
|
|
|
["--host" name
|
|
|
|
|
"set hostname of server to contact"
|
|
|
|
|
(set! server-hostname name)]
|
|
|
|
|
["--port" number
|
|
|
|
|
"set TCP port of server to contact"
|
|
|
|
|
(set! server-port (string->number number))]
|
2014-05-04 03:58:36 +00:00
|
|
|
|
["--logbook-entry-name" name
|
|
|
|
|
"set logbook entry name to use when recording run statistics"
|
2014-05-04 21:06:45 +00:00
|
|
|
|
(set! server-entry-name name)]
|
|
|
|
|
["--logbook-entry-type" type
|
|
|
|
|
"set logbook entry type to use"
|
|
|
|
|
(set! server-entry-type type)])
|
|
|
|
|
|
|
|
|
|
(when (not server-entry-type)
|
|
|
|
|
(error 'echo-client "Please supply the --logbook-entry-type command-line argument."))
|
2014-05-04 03:58:36 +00:00
|
|
|
|
|
|
|
|
|
(define L (default-logbook))
|
2014-05-04 21:06:45 +00:00
|
|
|
|
(define E (logbook-entry L "minimart" server-entry-name server-entry-type))
|
2014-05-04 20:30:23 +00:00
|
|
|
|
(when (not (logbook-machine-info-recorded? E))
|
|
|
|
|
(logbook-record-machine-info! E))
|
2014-05-04 03:58:36 +00:00
|
|
|
|
(define Tgrowth (logbook-table E "client-grow-times" #:column-spec '(initial-count
|
2014-05-05 17:18:38 +00:00
|
|
|
|
wallclock-secs/connection
|
|
|
|
|
connections/wallclock-sec
|
|
|
|
|
cpu+gc-sec
|
|
|
|
|
wallclock-sec
|
|
|
|
|
gc-sec
|
2014-05-04 03:58:36 +00:00
|
|
|
|
final-count)))
|
|
|
|
|
(define Tping (logbook-table E "client-ping-times" #:column-spec '(connection-count
|
|
|
|
|
secs/roundtrip
|
|
|
|
|
roundtrips/sec
|
|
|
|
|
roundtrip-count
|
|
|
|
|
run-duration-sec)))
|
2014-05-05 15:01:50 +00:00
|
|
|
|
(define Tsummary (logbook-table E "client-summary" #:column-spec #f))
|
2014-05-04 03:58:36 +00:00
|
|
|
|
|
|
|
|
|
;; We work our way through these waypoints: start with one connection,
|
|
|
|
|
;; then 10, then 20, etc etc until we reach the end.
|
|
|
|
|
(define waypoints
|
2015-03-18 20:15:23 +00:00
|
|
|
|
(list* 1 2 5
|
|
|
|
|
(let loop ((n 10))
|
|
|
|
|
(if (>= n 30000)
|
|
|
|
|
'()
|
2015-03-19 01:27:34 +00:00
|
|
|
|
(cons (inexact->exact (round n))
|
|
|
|
|
(loop (* n (sqrt (sqrt 2))))))))
|
2015-03-18 20:15:23 +00:00
|
|
|
|
;; (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
|
|
|
|
|
;; ;; Here on up, increase by ~1.2× each time
|
|
|
|
|
;; 1000 1200 1440 1728 2073
|
|
|
|
|
;; 2488 2985 3583 4299 5159
|
|
|
|
|
;; 6191 7430 8916 10699 12839
|
|
|
|
|
;; 15407 18488 22186 26623)
|
|
|
|
|
)
|
2014-05-04 03:58:36 +00:00
|
|
|
|
|
|
|
|
|
;; We exchange pings with the server for this many milliseconds before
|
|
|
|
|
;; moving up to the next waypoint.
|
2015-03-22 00:51:50 +00:00
|
|
|
|
(define ping-time 10000)
|
2014-05-04 03:58:36 +00:00
|
|
|
|
|
|
|
|
|
;; 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))
|
2014-05-05 15:01:39 +00:00
|
|
|
|
(define-values (in out) (tcp-connect server-hostname server-port))
|
2014-05-04 03:58:36 +00:00
|
|
|
|
(set! connections (hash-set connections i (c in out))))
|
|
|
|
|
|
|
|
|
|
;; Ping random connections for ping-time milliseconds.
|
2014-05-05 15:00:38 +00:00
|
|
|
|
(define (ping-randomly [record-results? #t])
|
2014-05-04 03:58:36 +00:00
|
|
|
|
(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))
|
2015-03-18 23:05:16 +00:00
|
|
|
|
(when record-results?
|
|
|
|
|
(let* ((elapsed-sec (/ (- now start-time) 1000.0))
|
2015-03-19 01:28:17 +00:00
|
|
|
|
(roundtrip-latency (if (zero? count)
|
|
|
|
|
elapsed-sec
|
|
|
|
|
(/ elapsed-sec count))))
|
2014-05-05 15:00:38 +00:00
|
|
|
|
(write-logbook-datum! Tping (list (connection-count)
|
|
|
|
|
roundtrip-latency
|
2015-03-19 03:19:31 +00:00
|
|
|
|
(if (zero? roundtrip-latency) 0 (/ 1.0 roundtrip-latency))
|
2014-05-05 15:00:38 +00:00
|
|
|
|
count
|
|
|
|
|
elapsed-sec)))))))
|
2014-05-04 03:58:36 +00:00
|
|
|
|
|
|
|
|
|
;; Add connections until we hit the given waypoint.
|
|
|
|
|
(define (grow-to-waypoint waypoint)
|
|
|
|
|
(define old-count (connection-count))
|
2014-05-05 17:18:38 +00:00
|
|
|
|
(collect-garbage)
|
|
|
|
|
(collect-garbage)
|
|
|
|
|
(collect-garbage)
|
|
|
|
|
(define-values (ignorable-results cpu+gc-time wallclock-time gc-time)
|
|
|
|
|
(time-apply
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let loop ()
|
|
|
|
|
(when (< (connection-count) waypoint)
|
|
|
|
|
(start-connection)
|
|
|
|
|
(loop)))
|
|
|
|
|
(ping-connection (- waypoint 1))) ;; make sure the newest connection is really live.
|
|
|
|
|
'()))
|
|
|
|
|
(define cpu+gc-sec (/ cpu+gc-time 1000.0))
|
|
|
|
|
(define wallclock-sec (/ wallclock-time 1000.0))
|
|
|
|
|
(define gc-sec (/ gc-time 1000.0))
|
2014-05-04 03:58:36 +00:00
|
|
|
|
(write-logbook-datum! Tgrowth (list old-count
|
2014-05-05 17:18:38 +00:00
|
|
|
|
(/ wallclock-sec (- waypoint old-count))
|
2015-03-19 03:19:31 +00:00
|
|
|
|
(if (zero? wallclock-sec) 0 (/ (- waypoint old-count) wallclock-sec))
|
2014-05-05 17:18:38 +00:00
|
|
|
|
cpu+gc-sec
|
|
|
|
|
wallclock-sec
|
|
|
|
|
gc-sec
|
2014-05-04 03:58:36 +00:00
|
|
|
|
waypoint)))
|
|
|
|
|
|
|
|
|
|
(let loop ((remaining-waypoints waypoints))
|
|
|
|
|
(match remaining-waypoints
|
|
|
|
|
['() (void)]
|
|
|
|
|
[(cons next-waypoint rest)
|
2014-05-05 15:33:50 +00:00
|
|
|
|
(when (<= next-waypoint max-waypoint)
|
2015-03-18 21:13:36 +00:00
|
|
|
|
(printf "Moving to waypoint ~a\n" next-waypoint)
|
2014-05-05 15:33:50 +00:00
|
|
|
|
(grow-to-waypoint next-waypoint)
|
|
|
|
|
(when (equal? remaining-waypoints waypoints) ;; First ever waypoint. Do some warmup.
|
2014-05-05 17:18:49 +00:00
|
|
|
|
(printf "Warming up.\n")
|
2014-05-05 15:33:50 +00:00
|
|
|
|
(ping-randomly #f)
|
2014-05-05 17:18:49 +00:00
|
|
|
|
(printf "Warmup complete. Proceeding with real measurements.\n"))
|
|
|
|
|
(printf "At waypoint ~a\n" next-waypoint)
|
2014-05-05 15:33:50 +00:00
|
|
|
|
(ping-randomly)
|
|
|
|
|
(loop rest))]))
|
2014-05-05 15:01:50 +00:00
|
|
|
|
|
|
|
|
|
(let ()
|
|
|
|
|
(write-logbook-datum! Tsummary #:label "server-hostname" server-hostname)
|
|
|
|
|
(write-logbook-datum! Tsummary #:label "server-port" server-port)
|
|
|
|
|
(write-logbook-datum! Tsummary #:label "ping-time" ping-time)
|
2014-05-05 15:33:50 +00:00
|
|
|
|
(write-logbook-datum! Tsummary #:label "max-waypoint" max-waypoint)
|
|
|
|
|
(write-logbook-datum! Tsummary #:label "waypoints" waypoints)
|
2015-03-19 01:28:24 +00:00
|
|
|
|
(printf "echo-client finished.\n")
|
2014-05-05 15:01:50 +00:00
|
|
|
|
(void))
|