Experimental variation that uses the minimart TCP driver
This commit is contained in:
parent
4e031e7278
commit
0795466fe4
|
@ -0,0 +1,79 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/match)
|
||||
(require racket/port)
|
||||
(require minimart)
|
||||
(require minimart/demand-matcher)
|
||||
(require minimart/drivers/timer)
|
||||
(require minimart/drivers/tcp)
|
||||
(require logbook)
|
||||
(require racket/cmdline)
|
||||
|
||||
(define server-entry-name #f)
|
||||
(define server-entry-type #f)
|
||||
|
||||
(command-line #:program "echo-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 'echo-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)
|
||||
|
||||
(define (statistician)
|
||||
(list (spawn (lambda (e s)
|
||||
(match e
|
||||
[(message (timer-expired 'statistician now) _ _)
|
||||
;; (collect-garbage)
|
||||
;; (collect-garbage)
|
||||
;; (collect-garbage)
|
||||
(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))
|
||||
(transition s
|
||||
(send (set-timer 'statistician statistics-poll-interval 'relative)))]
|
||||
[_ #f]))
|
||||
#f
|
||||
(sub (timer-expired 'statistician ?)))
|
||||
(send (set-timer 'statistician statistics-poll-interval 'relative))))
|
||||
|
||||
(define (listener port-number)
|
||||
(define server-id (tcp-listener port-number))
|
||||
(spawn-demand-matcher (tcp-channel (?! (tcp-address ? ?)) server-id ?)
|
||||
(spawn-connection-handler server-id)))
|
||||
|
||||
(define ((spawn-connection-handler server-id) c)
|
||||
(set! connection-count (+ connection-count 1))
|
||||
(set! first-connection-seen? #t)
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(routing-update (? gestalt-empty?))
|
||||
(set! connection-count (- connection-count 1))
|
||||
(transition s (quit))]
|
||||
[(message (tcp-channel src dst bs) _ _)
|
||||
(transition s (send (tcp-channel dst src bs)))]
|
||||
[_ #f]))
|
||||
#f
|
||||
(gestalt-union (sub (tcp-channel c server-id ?))
|
||||
(sub (tcp-channel c server-id ?) #:level 1)
|
||||
(pub (tcp-channel server-id c ?)))))
|
||||
|
||||
(run-ground (spawn-timer-driver)
|
||||
(spawn-tcp-driver)
|
||||
(listener 5999)
|
||||
(statistician))
|
Loading…
Reference in New Issue