diff --git a/external-latency.rkt b/external-latency.rkt index 35bb845..6ffd12d 100644 --- a/external-latency.rkt +++ b/external-latency.rkt @@ -21,6 +21,7 @@ ["--erlang" "use erlang server" (set! server-variation 'erlang)] ["--uv" "use libuv server" (set! server-variation 'uv)] ["--minimart" "use minimart server" (set! server-variation 'minimart)] + ["--racket" "use plain racket server" (set! server-variation 'racket)] ["--other" name "use other server" (set! server-variation name)]) (when (not server-variation) @@ -52,6 +53,10 @@ (format "racket echo-server.rkt --logbook-entry-name ~a --logbook-entry-type ~a" entry-name entry-type)] + ['racket + (format "racket plain-racket-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().'") diff --git a/plain-racket-server.rkt b/plain-racket-server.rkt new file mode 100644 index 0000000..7d2e1f4 --- /dev/null +++ b/plain-racket-server.rkt @@ -0,0 +1,70 @@ +#lang racket/base + +(require racket/match) +(require racket/tcp) +(require racket/port) +(require logbook) +(require racket/cmdline) + +(define server-entry-name #f) +(define server-entry-type #f) + +(command-line #:program "plain-racket-server.rkt" + #:once-each + ["--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 'plain-racket-server "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)) +(define Tmem (logbook-table E "server-memory-use" #:column-spec '(time-seconds memory-use))) +(define Tconn (logbook-table E "server-connections" #:column-spec '(time-seconds connection-count))) + +(define connection-count 0) +(define first-connection-seen? #f) + +(define statistics-poll-interval 2000) + +(void (thread + (lambda () + (let loop () + (sleep (/ statistics-poll-interval 1000.0)) + (printf "~a connections\n" connection-count) + (flush-output) + (define now (current-inexact-milliseconds)) + (write-logbook-datum! Tmem (list (/ now 1000.0) (current-memory-use))) + (write-logbook-datum! Tconn (list (/ now 1000.0) connection-count)) + (when (and first-connection-seen? (zero? connection-count)) + (exit 0)) + (loop))))) + +(define (connection in out) + (set! connection-count (+ connection-count 1)) + (set! first-connection-seen? #t) + (thread + (lambda () + (let loop () + (match (read-line in 'any) + [(? eof-object?) + (close-input-port in) + (close-output-port out) + (set! connection-count (- connection-count 1))] + [line + (fprintf out "~a\n" line) + (flush-output out) + (loop)]))))) + +(define (listener port-number) + (define s (tcp-listen port-number 4 #t)) + (let loop () + (define-values (in out) (tcp-accept s)) + (connection in out) + (loop))) + +(listener 5999)