minimart-benchmark-2017/external-latency.rkt

122 lines
4.4 KiB
Racket

#lang racket/base
(require racket/match)
(require racket/system)
(require racket/string)
(require racket/port)
(require racket/cmdline)
(require logbook)
(define server-variation #f)
(define server-hostname "localhost")
(define max-waypoint #f)
(command-line #:program "external-latency.rkt"
#:once-each
["--host" name "hostname where server is reachable" (set! server-hostname name)]
["--max-waypoint" n
"set maximum waypoint for this run"
(set! max-waypoint (string->number n))]
#:once-any
["--erlang" "use erlang server" (set! server-variation 'erlang)]
["--uv" "use libuv server" (set! server-variation 'uv)]
["--minimart" "use minimart server" (set! server-variation 'minimart)]
["--minimart+tcp"
"use minimart server with TCP driver"
(set! server-variation 'minimart+tcp)]
["--prospect+tcp"
"use prospect server with TCP driver"
(set! server-variation 'prospect+tcp)]
["--imperative-syndicate+tcp"
"use imperative-syndicate server with TCP driver"
(set! server-variation 'imperative-syndicate+tcp)]
["--syndicate-js"
"use Syndicate/js"
(set! server-variation 'syndicate-js)]
["--racket" "use threaded racket server" (set! server-variation 'racket)]
["--racket-evt" "use evented racket server" (set! server-variation 'racket-evt)]
["--racket-semi-threaded" "use semi-threaded racket server" (set! server-variation 'racket-semi-threaded)]
["--other" name "use other server" (set! server-variation name)])
(when (not server-variation)
(error 'external-latency "Please choose a server variation."))
(define entry-type (format "external-latency-~a" server-variation))
(define L (default-logbook))
(define E (standard-logbook-entry L "minimart" entry-type))
(define entry-name (logbook-entry-name E))
(define Tmachine (logbook-table E "machine-info" "machine-info"))
(define (start-bg command)
(match-define (list #f #f pid #f control)
(process/ports (current-output-port)
(current-input-port)
(current-error-port)
command))
control)
(define (capture-output command)
(string-trim (with-output-to-string (lambda () (system command)))))
(define (format-racket-server-command-line file)
(format "racket ~a --logbook-entry-name ~a --logbook-entry-type ~a"
file
entry-name
entry-type))
(log-info "Starting server...")
(define server-control
(start-bg
(match server-variation
['minimart (format-racket-server-command-line "echo-server.rkt")]
['minimart+tcp (format-racket-server-command-line "echo-server-minimart-tcp-driver.rkt")]
['prospect+tcp (format-racket-server-command-line "echo-server-prospect-tcp-driver.rkt")]
['imperative-syndicate+tcp (format-racket-server-command-line "echo-server-imperative-syndicate-tcp-driver.rkt")]
['racket (format-racket-server-command-line "plain-racket-server.rkt")]
['racket-evt (format-racket-server-command-line "plain-racket-server-evt.rkt")]
['racket-semi-threaded (format-racket-server-command-line "plain-racket-server-semi-threaded.rkt")]
['erlang
(define erlang-version-command
"erl -noshell -eval 'io:format(erlang:system_info(otp_release)), halt().'")
(write-logbook-datum! Tmachine
#:label "erlang-version"
(capture-output erlang-version-command))
"./run-erlang-server.sh"]
['uv
(write-logbook-datum! Tmachine #:label "uv-banner" (capture-output "./uvserver -v"))
"./uvserver"]
['syndicate-js
"node echo-server-syndicate-js.js"]
[(? string? other)
(printf "Please start the other server on hostname '~a' now.\n" server-hostname)
(printf "Press enter when it has started.\n")
(read-line)
(printf "Continuing...\n")
"true"
])))
(sleep 5)
(log-info "Starting client...")
(define client-control
(start-bg
(format "racket echo-client.rkt ~a--host ~a --logbook-entry-name ~a --logbook-entry-type ~a"
(if max-waypoint (format "--max-waypoint ~a " max-waypoint) "")
server-hostname
entry-name
entry-type)))
(log-info "Waiting for client termination...")
(client-control 'wait)
(log-info "Waiting for server termination...")
(void (match server-variation
[(? string? other)
(printf "Press enter when the server has terminated.\n")
(read-line)]
[_ (void)]))
(server-control 'wait)
(log-info "Done.")