minimart-benchmark-2017/echo-client.rkt

#lang racket/base

(require racket/match)
(require racket/tcp)
(require racket/cmdline)
(require logbook)

(define server-entry-name (standard-logbook-entry-name))
(define server-entry-type #f)
(define server-hostname "localhost")
(define server-port 5999)
(define max-waypoint 1000)

(command-line #:program "echo-client.rkt"
	      #:once-each
	      ["--max-waypoint" n
	       "set maximum waypoint for this run"
	       (set! max-waypoint (string->number n))]
	      ["--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))]
	      ["--logbook-entry-name" name
	       "set logbook entry name to use when recording run statistics"
	       (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."))

(define L (default-logbook))
(define E (logbook-entry L "minimart" server-entry-name server-entry-type))
(when (not (logbook-machine-info-recorded? E))
  (logbook-record-machine-info! E))
(define Tgrowth (logbook-table E "client-grow-times" #:column-spec '(initial-count
								     wallclock-secs/connection
								     connections/wallclock-sec
								     cpu+gc-sec
								     wallclock-sec
								     gc-sec
								     final-count)))
(define Tping (logbook-table E "client-ping-times" #:column-spec '(connection-count
								   secs/roundtrip
								   roundtrips/sec
								   roundtrip-count
								   run-duration-sec)))
(define Tsummary (logbook-table E "client-summary" #:column-spec #f))

;; 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 2 5
         (let loop ((n 10))
           (if (>= n 30000)
               '()
               (cons (inexact->exact (round n))
                     (loop (* n (sqrt (sqrt 2))))))))
  ;; (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)
  )

;; We exchange pings with the server for this many milliseconds before
;; moving up to the next waypoint.
(define ping-time 10000)

;; 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 server-hostname server-port))
  (set! connections (hash-set connections i (c in out))))

;; Ping random connections for ping-time milliseconds.
(define (ping-randomly [record-results? #t])
  (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))
        (when record-results?
          (let* ((elapsed-sec (/ (- now start-time) 1000.0))
                 (roundtrip-latency (if (zero? count)
                                        elapsed-sec
                                        (/ elapsed-sec count))))
	    (write-logbook-datum! Tping (list (connection-count)
					      roundtrip-latency
					      (if (zero? roundtrip-latency) 0 (/ 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))
  (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))
  (write-logbook-datum! Tgrowth (list old-count
				      (/ wallclock-sec (- waypoint old-count))
				      (if (zero? wallclock-sec) 0 (/ (- waypoint old-count) wallclock-sec))
				      cpu+gc-sec
				      wallclock-sec
				      gc-sec
				      waypoint)))

(let loop ((remaining-waypoints waypoints))
  (match remaining-waypoints
    ['() (void)]
    [(cons next-waypoint rest)
     (when (<= next-waypoint max-waypoint)
       (printf "Moving to waypoint ~a\n" next-waypoint)
       (grow-to-waypoint next-waypoint)
       (when (equal? remaining-waypoints waypoints) ;; First ever waypoint. Do some warmup.
	 (printf "Warming up.\n")
	 (ping-randomly #f)
	 (printf "Warmup complete. Proceeding with real measurements.\n"))
       (printf "At waypoint ~a\n" next-waypoint)
       (ping-randomly)
       (loop rest))]))

(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)
  (write-logbook-datum! Tsummary #:label "max-waypoint" max-waypoint)
  (write-logbook-datum! Tsummary #:label "waypoints" waypoints)
  (printf "echo-client finished.\n")
  (void))