67 lines
2.5 KiB
Racket
67 lines
2.5 KiB
Racket
#lang imperative-syndicate
|
|
|
|
(require racket/port)
|
|
(require logbook)
|
|
(require racket/cmdline)
|
|
|
|
(require/activate imperative-syndicate/drivers/timer)
|
|
(require/activate imperative-syndicate/drivers/tcp)
|
|
|
|
(begin-for-declarations
|
|
(define server-entry-name #f)
|
|
(define server-entry-type #f)
|
|
|
|
(command-line #:program "echo-server-imperative-syndicate-tcp-driver.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)
|
|
(spawn #:name 'statistician
|
|
(field [sample-deadline (+ (current-inexact-milliseconds) statistics-poll-interval)])
|
|
(on (asserted (later-than (sample-deadline)))
|
|
;; (collect-garbage)
|
|
;; (collect-garbage)
|
|
;; (collect-garbage)
|
|
(define now (sample-deadline))
|
|
(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))
|
|
(sample-deadline (+ (sample-deadline) statistics-poll-interval)))))
|
|
|
|
(define (listener port-number)
|
|
(spawn #:name 'listener
|
|
(during/spawn (tcp-connection $id (tcp-listener port-number))
|
|
#:name (list 'connection id)
|
|
(assert (tcp-accepted id))
|
|
(on-start
|
|
(issue-credit! (tcp-listener port-number))
|
|
(issue-unbounded-credit! tcp-in id)
|
|
(set! connection-count (+ connection-count 1))
|
|
(set! first-connection-seen? #t))
|
|
(on-stop
|
|
(set! connection-count (- connection-count 1)))
|
|
(on (message (tcp-in id $bs))
|
|
(send! (tcp-out id bs))))))
|
|
|
|
(listener 5999)
|
|
(statistician)
|