122 lines
4.4 KiB
Racket
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.")
|