app.rkt

#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)))

main.rkt

#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))
      (tcp-abandon-port out)
      (tcp-abandon-port in)
      (loop (modulo (add1 idx) num-places)))))