Instrumented echo server
This commit is contained in:
parent
1c07014f60
commit
b42488c871
|
@ -0,0 +1,62 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/match)
|
||||
(require racket/tcp)
|
||||
(require racket/port)
|
||||
(require minimart)
|
||||
(require minimart/drivers/timer)
|
||||
(require logbook)
|
||||
|
||||
(define L (default-logbook))
|
||||
(define E (standard-logbook-entry L "minimart" "echo-server"))
|
||||
(define Tmem (logbook-table E "memory-use" #:column-spec '(time-ms memory-use)))
|
||||
(define Tconn (logbook-table E "connections" #:column-spec '(time-ms connection-count)))
|
||||
|
||||
(define connection-count 0)
|
||||
|
||||
(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))
|
||||
(transition s (send (set-timer 'statistician 10000 'relative)))]
|
||||
[_ #f]))
|
||||
#f
|
||||
(list (sub (timer-expired 'statistician ?))))
|
||||
(send (set-timer 'statistician 10000 'relative))))
|
||||
|
||||
(define (listener port-number)
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(message (event _ (list (list in out))) _ _)
|
||||
(transition s (connection in out))]
|
||||
[_ #f]))
|
||||
#f
|
||||
(list (sub (event (tcp-accept-evt (tcp-listen port-number 4 #t)) ?)
|
||||
#:meta-level 1))))
|
||||
|
||||
(define (connection in out)
|
||||
(set! connection-count (+ connection-count 1))
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(message (event _ (list (? eof-object?))) _ _)
|
||||
(close-input-port in)
|
||||
(close-output-port out)
|
||||
(set! connection-count (- connection-count 1))
|
||||
(transition s (quit))]
|
||||
[(message (event _ (list line)) _ _)
|
||||
(fprintf out "~a\n" line)
|
||||
(flush-output out)
|
||||
(transition s '())]
|
||||
[_ #f]))
|
||||
#f
|
||||
(list (sub (event (read-line-evt in 'any) ?)
|
||||
#:meta-level 1))))
|
||||
|
||||
(run-ground (listener 5999)
|
||||
(spawn-timer-driver)
|
||||
(statistician))
|
Loading…
Reference in New Issue