2014-05-04 19:55:11 +00:00
|
|
|
#lang racket/base
|
|
|
|
|
|
|
|
(require racket/match)
|
|
|
|
(require racket/system)
|
2014-05-04 21:06:45 +00:00
|
|
|
(require racket/string)
|
|
|
|
(require racket/port)
|
|
|
|
(require racket/cmdline)
|
2014-05-04 19:55:11 +00:00
|
|
|
(require logbook)
|
|
|
|
|
2014-05-04 21:06:45 +00:00
|
|
|
(define server-variation #f)
|
2014-05-05 15:01:39 +00:00
|
|
|
(define server-hostname "localhost")
|
2014-05-05 15:33:50 +00:00
|
|
|
(define max-waypoint #f)
|
2014-05-04 21:06:45 +00:00
|
|
|
|
|
|
|
(command-line #:program "external-latency.rkt"
|
2014-05-05 15:01:39 +00:00
|
|
|
#:once-each
|
|
|
|
["--host" name "hostname where server is reachable" (set! server-hostname name)]
|
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-04 21:06:45 +00:00
|
|
|
#:once-any
|
|
|
|
["--erlang" "use erlang server" (set! server-variation 'erlang)]
|
2014-05-05 16:04:42 +00:00
|
|
|
["--uv" "use libuv server" (set! server-variation 'uv)]
|
2014-05-05 15:02:03 +00:00
|
|
|
["--minimart" "use minimart server" (set! server-variation 'minimart)]
|
|
|
|
["--other" name "use other server" (set! server-variation name)])
|
2014-05-04 21:06:45 +00:00
|
|
|
|
|
|
|
(when (not server-variation)
|
|
|
|
(error 'external-latency "Please choose a server variation."))
|
|
|
|
|
|
|
|
(define entry-type (format "external-latency-~a" server-variation))
|
|
|
|
|
2014-05-04 20:02:37 +00:00
|
|
|
(define L (default-logbook))
|
2014-05-04 21:06:45 +00:00
|
|
|
(define E (standard-logbook-entry L "minimart" entry-type))
|
2014-05-04 20:02:37 +00:00
|
|
|
(define entry-name (logbook-entry-name E))
|
2014-05-04 21:06:45 +00:00
|
|
|
(define Tmachine (logbook-table E "machine-info" "machine-info"))
|
2014-05-04 19:55:11 +00:00
|
|
|
|
|
|
|
(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)
|
|
|
|
|
2014-05-05 16:04:42 +00:00
|
|
|
(define (capture-output command)
|
|
|
|
(string-trim (with-output-to-string (lambda () (system command)))))
|
|
|
|
|
2014-05-04 19:55:11 +00:00
|
|
|
(log-info "Starting server...")
|
|
|
|
(define server-control
|
2014-05-04 21:06:45 +00:00
|
|
|
(start-bg
|
|
|
|
(match server-variation
|
|
|
|
['minimart
|
|
|
|
(format "racket echo-server.rkt --logbook-entry-name ~a --logbook-entry-type ~a"
|
|
|
|
entry-name
|
|
|
|
entry-type)]
|
|
|
|
['erlang
|
|
|
|
(define erlang-version-command
|
|
|
|
"erl -noshell -eval 'io:format(erlang:system_info(otp_release)), halt().'")
|
|
|
|
(write-logbook-datum! Tmachine
|
|
|
|
#:label "erlang-version"
|
2014-05-05 16:04:42 +00:00
|
|
|
(capture-output erlang-version-command))
|
2014-05-05 15:02:03 +00:00
|
|
|
"./run-erlang-server.sh"]
|
2014-05-05 16:04:42 +00:00
|
|
|
['uv
|
|
|
|
(write-logbook-datum! Tmachine #:label "uv-banner" (capture-output "./uvserver -v"))
|
|
|
|
"./uvserver"]
|
2014-05-05 15:02:03 +00:00
|
|
|
[(? 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"
|
|
|
|
])))
|
2014-05-04 19:55:11 +00:00
|
|
|
|
|
|
|
(sleep 5)
|
|
|
|
|
|
|
|
(log-info "Starting client...")
|
|
|
|
(define client-control
|
2014-05-04 21:06:45 +00:00
|
|
|
(start-bg
|
2014-05-05 15:33:50 +00:00
|
|
|
(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) "")
|
2014-05-05 15:01:39 +00:00
|
|
|
server-hostname
|
2014-05-04 21:06:45 +00:00
|
|
|
entry-name
|
|
|
|
entry-type)))
|
2014-05-04 19:55:11 +00:00
|
|
|
|
|
|
|
(log-info "Waiting for client termination...")
|
|
|
|
(client-control 'wait)
|
2014-05-05 15:02:03 +00:00
|
|
|
|
2014-05-04 19:55:11 +00:00
|
|
|
(log-info "Waiting for server termination...")
|
2014-05-05 15:02:03 +00:00
|
|
|
(void (match server-variation
|
|
|
|
[(? string? other)
|
|
|
|
(printf "Press enter when the server has terminated.\n")
|
2014-05-05 16:03:31 +00:00
|
|
|
(read-line)]
|
|
|
|
[_ (void)]))
|
2014-05-05 15:02:03 +00:00
|
|
|
|
2014-05-04 19:55:11 +00:00
|
|
|
(server-control 'wait)
|
|
|
|
(log-info "Done.")
|