Skip to content

Instantly share code, notes, and snippets.

@Bogdanp

Bogdanp/app.rkt Secret

Last active Jan 1, 2022
Embed
What would you like to do?
#lang racket/base
(require web-server/dispatch
web-server/http
web-server/servlet-dispatch
web-server/web-server)
(provide
start)
(define-values (app _)
(dispatch-rules
[("")
(λ (_req)
(response/output
(λ (out)
(displayln "hello, world" out))))]
[else
(λ (_req)
(response/output
#:code 404
(λ (out)
(displayln "not found" out))))]))
(define (start host port tcp@)
(serve
#:dispatch (dispatch/servlet app)
#:listen-ip host
#:port port
#:tcp@ tcp@))
(module+ main
(define stop (start "127.0.0.1" 8000))
(with-handlers ([exn:break? (λ (_)
(stop))])
(sync never-evt)))
#lang racket/base
(require (only-in net/tcp-sig tcp^)
racket/match
racket/place
(prefix-in tcp: racket/tcp)
racket/unit
"app.rkt")
(struct place-tcp-listener ())
(define (make-place-tcp@ accept-ch)
(unit
(import)
(export tcp^)
(define (tcp-addresses _p [port-numbers? #f])
(if port-numbers?
(values "127.0.0.1" 1 "127.0.0.1" 0)
(values "127.0.0.1" "127.0.0.1")))
(define (tcp-connect _hostname
_port-no
[_local-hostname #f]
[_local-port-no #f])
(error 'tcp-connect "not supported"))
(define (tcp-connect/enable-break _hostname
_port-no
[_local-hostname #f]
[_local-port-no #f])
(error 'tcp-connect/enable-break "not supported"))
(define (tcp-abandon-port p)
(tcp:tcp-abandon-port p))
(define (tcp-listen _port-no
[_backlog 4]
[_reuse? #f]
[_hostname #f])
(place-tcp-listener))
(define (tcp-listener? l)
(place-tcp-listener? l))
(define (tcp-close _l)
(void))
(define (tcp-accept _l)
(apply values (channel-get accept-ch)))
(define (tcp-accept/enable-break _l)
(apply values (sync/enable-break accept-ch)))
(define (tcp-accept-ready? _l)
(error 'tcp-accept-ready? "not supported"))))
(define (start-place)
(place ch
(define connections-ch (make-channel))
(define tcp@ (make-place-tcp@ connections-ch))
(let loop ([stop void])
(match (sync ch)
[`(init ,host ,port)
(loop (start host port tcp@))]
[`(accept ,in ,out)
(channel-put connections-ch (list in out))
(loop stop)]
[`(stop)
(stop)]))))
(module+ main
(require racket/tcp)
(define num-places 4)
(define places
(for/list ([_ (in-range num-places)])
(define pch (start-place))
(begin0 pch
(place-channel-put pch `(init "127.0.0.1" 8000)))))
(define listener
(tcp-listen 8000 4096 #t "127.0.0.1"))
(with-handlers ([exn:break? (λ (_)
(for ([pch (in-list places)])
(place-channel-put pch '(stop)))
(for-each place-wait places)
(tcp-close listener))])
(let loop ([idx 0])
(define pch (list-ref places idx))
(define-values (in out)
(tcp-accept listener))
(place-channel-put pch `(accept ,in ,out))
(loop (modulo (add1 idx) num-places)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment