racket: use places for parallelism (#7003)

frameworks/Racket/racket/app.rkt

@@ -2,17 +2,22 @@
 
 (require db
          json
+         racket/async-channel
          racket/fasl
          racket/port
          racket/serialize
-         racket/unix-socket-tcp-unit
          redis
          threading
          web-server/dispatch
          web-server/http
          web-server/http/response
+         web-server/safety-limits
+         web-server/web-server
          xml)
 
+(provide
+ start)
+
 ;; db ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define *db*
@@ -97,8 +102,8 @@
     (query-exec *db* update-one-world (world-id r) (world-n r))))
 
 (define (world->hash r)
-  (hash 'id (world-id r)
-        'randomNumber (world-n r)))
+  (hasheq 'id (world-id r)
+          'randomNumber (world-n r)))
 
 
 ;; fortune ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -208,19 +213,7 @@
       (response/json
        (map world->hash worlds)))]))
 
-(module+ main
-  (require racket/async-channel
-           racket/cmdline
-           racket/format
-           web-server/http/response
-           web-server/safety-limits
-           web-server/web-server)
-
-  (define port
-    (command-line
-     #:args (port)
-     (string->number port)))
-
+(define (start host port tcp@)
   (define (app c req)
     (output-response c (dispatch req)))
 
@@ -228,9 +221,9 @@
   (define stop
     (serve
      #:dispatch app
-     #:listen-ip "127.0.0.1"
+     #:listen-ip host
      #:port port
-     #:tcp@ (make-unix-socket-tcp@ (format "~a.sock" port))
+     #:tcp@ tcp@
      #:confirmation-channel ch
      #:safety-limits (make-safety-limits
                       #:max-waiting 4096
@@ -242,11 +235,4 @@
   (when (exn:fail? ready-or-exn)
     (raise ready-or-exn))
 
-  (call-with-output-file (build-path (~a port ".ready"))
-    (lambda (out)
-      (displayln "ready" out)))
-
-  (with-handlers ([exn:break?
-                   (lambda (_e)
-                     (stop))])
-    (sync/enable-break never-evt)))
+  stop)

frameworks/Racket/racket/config/nginx.conf.tpl

@@ -1,36 +0,0 @@
-daemon off;
-worker_processes $NGINX_WORKER_PROCESES;
-worker_cpu_affinity auto;
-timer_resolution 1s;
-error_log stderr error;
-
-events {
-  multi_accept on;
-  worker_connections 65535;
-}
-
-http {
-  access_log    off;
-  server_tokens off;
-  msie_padding  off;
-
-  sendfile    on;
-  tcp_nopush  on;
-  tcp_nodelay on;
-
-  keepalive_timeout  65;
-  keepalive_disable  none;
-  keepalive_requests 1000000;
-
-  include /racket/config/upstream.conf;
-
-  server {
-    listen 8080 default_server reuseport deferred backlog=65535 fastopen=4096;
-
-    location / {
-      proxy_pass            http://app;
-      proxy_http_version    1.1;
-      proxy_set_header      Connection "";
-    }
-  }
-}

frameworks/Racket/racket/main.rkt

@@ -0,0 +1,95 @@
+#lang racket/base
+
+(require racket/cmdline
+         racket/match
+         racket/place
+         racket/tcp
+         (prefix-in app: "app.rkt")
+         "place-tcp-unit.rkt")
+
+(define (start-place)
+  (place ch
+    (define accept-ch (make-channel))
+    (define tcp (make-place-tcp@ accept-ch))
+    (define stop #f)
+
+    (let loop ([pid #f])
+      (match (sync ch)
+        [`(stop)
+         (stop)
+         (eprintf "place ~a stopped~n" pid)]
+        [`(init ,pid ,host ,port)
+         (set! stop (app:start host port tcp))
+         (eprintf "place ~a ready~n" pid)
+         (loop pid)]
+        [`(accept ,in ,out)
+         (channel-put accept-ch (list in out))
+         (loop pid)]))))
+
+(module+ main
+  (define-values (host port parallelism)
+    (let ([host "127.0.0.1"]
+          [port 8000]
+          [parallelism (processor-count)])
+      (command-line
+       #:once-each
+       [("--host" "-H") HOST "the host to listen on" (set! host HOST)]
+       [("--port" "-p") PORT "the port to bind to"
+                        (define port-num (string->number PORT))
+                        (unless (and port-num (>= port-num 0) (< port-num 65536))
+                          (eprintf "error: PORT must be a number between 0 and 65535, inclusive~n")
+                          (exit 1))
+                        (set! port port-num)]
+       [("--parallelism" "-P") PARALLELISM "the number of parallel places to run"
+                               (define n-places (string->number PARALLELISM))
+                               (unless (and n-places (positive? n-places))
+                                 (eprintf "error: PARALLELISM must be a positive number~n")
+                                 (exit 1))
+                               (set! parallelism n-places)]
+       #:args []
+       (values host port parallelism))))
+
+  (define places
+    (for/list ([pid (in-range parallelism)])
+      (define p (start-place))
+      (begin0 p
+        (place-channel-put p `(init ,pid ,host ,port)))))
+  (define (stop-places)
+    (for ([ch (in-list places)])
+      (place-channel-put ch `(stop)))
+    (for-each place-wait places))
+  (define place-fail-evt
+    (apply choice-evt (map place-dead-evt places)))
+
+  (define backlog
+    (* parallelism 4 1024))
+  (define listener
+    (tcp-listen port backlog #t host))
+  (define stop-ch (make-channel))
+  (define listener-thd
+    (thread
+     (lambda ()
+       (define places* (list->vector places))
+       (define num-places (vector-length places*))
+       (let loop ([idx 0])
+         (sync
+          (handle-evt
+           listener
+           (lambda (_)
+             (define-values (in out)
+               (tcp-accept listener))
+             (place-channel-put (vector-ref places* idx) `(accept ,in, out))
+             (loop (modulo (add1 idx) num-places))))
+          (handle-evt
+           (choice-evt stop-ch place-fail-evt)
+           (lambda (_)
+             (stop-places)
+             (tcp-close listener))))))))
+  (define (stop)
+    (channel-put stop-ch #t)
+    (thread-wait listener-thd))
+
+  (with-handlers ([exn:break?
+                   (lambda (_e)
+                     (stop))])
+    (sync/enable-break never-evt listener-thd)))

frameworks/Racket/racket/place-tcp-unit.rkt

@@ -0,0 +1,56 @@
+#lang racket/base
+
+(require net/tcp-sig
+         (prefix-in tcp: racket/tcp)
+         racket/unit)
+
+(provide
+ make-place-tcp@)
+
+(struct place-tcp-listener ())
+
+(define (make-place-tcp@ accept-ch)
+  (unit
+    (import)
+    (export tcp^)
+
+    (define (tcp-abandon-port p)
+      (tcp:tcp-abandon-port p))
+
+    (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 (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-close _l)
+      (void))
+
+    (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-listen _port-no
+                        [_backlog 4]
+                        [_reuse? #f]
+                        [_hostname #f])
+      (place-tcp-listener))
+
+    (define (tcp-listener? l)
+      (place-tcp-listener? l))))

frameworks/Racket/racket/racket.dockerfile

@@ -11,14 +11,14 @@ RUN echo 'APT::Get::Install-Recommends "false";' > /etc/apt/apt.conf.d/00-genera
 
 FROM debian AS racket
 
-ARG RACKET_VERSION=8.1
+ARG RACKET_VERSION=8.3
 
 RUN apt-get update -q \
     && apt-get install --no-install-recommends -q -y \
          ca-certificates curl libcurl3-gnutls \
     && rm -rf /var/lib/apt/lists/* \
     && curl -L -o racket-install.sh \
-         -O http://mirror.racket-lang.org/installers/${RACKET_VERSION}/racket-minimal-${RACKET_VERSION}-x86_64-linux-cs.sh \
+         -O http://mirror.racket-lang.org/installers/${RACKET_VERSION}/racket-${RACKET_VERSION}-x86_64-linux-cs.sh \
     && echo "yes\n1\n" | sh racket-install.sh --create-dir --unix-style --dest /usr/ \
     && rm racket-install.sh
 
@@ -26,18 +26,19 @@ ENV SSL_CERT_FILE="/etc/ssl/certs/ca-certificates.crt"
 ENV SSL_CERT_DIR="/etc/ssl/certs"
 
 RUN apt-get update -q \
-  && apt-get install --no-install-recommends -q -y nginx redis-server
+  && apt-get install --no-install-recommends -q -y redis-server
 
 
 FROM racket AS builder
 
-RUN raco pkg install -D --auto compiler-lib db-lib redis-lib threading-lib unix-socket-lib web-server-lib
+RUN raco pkg install -D --auto --skip-installed redis-lib threading-lib
 
 WORKDIR /racket
 ADD  . .
 
-RUN raco make app.rkt \
-  && raco exe app.rkt
+RUN raco make main.rkt \
+    && raco exe -o app main.rkt \
+    && raco dist dist app
 
 
 FROM racket
@@ -46,7 +47,7 @@ RUN apt-get update -q \
   && apt-get install --no-install-recommends -q -y gettext-base
 
 WORKDIR /racket
-COPY --from=builder /racket/app .
+COPY --from=builder /racket/dist .
 ADD config config
 ADD scripts scripts
 

frameworks/Racket/racket/scripts/run

@@ -6,37 +6,4 @@ echo never > /sys/kernel/mm/transparent_hugepage/enabled
 redis-server /racket/config/redis.conf &
 
 export PLT_INCREMENTAL_GC=1
-
-CORES=$(("$(nproc --all)" * 1))
-CONF="/racket/config/upstream.conf"
-
-cat >"$CONF" <<EOF
-upstream app {
-  least_conn;
-EOF
-
-for i in $(seq 0 $CORES); do
-    port=$((8081 + i))
-    /racket/app "$port" &
-    echo "  server unix:///racket/$port.sock;" >> "$CONF"
-done
-
-cat >>"$CONF" <<EOF
-  keepalive 512;
-}
-EOF
-
-for i in $(seq 0 $CORES); do
-    port=$((8081 + i))
-    filename="/racket/$port.ready"
-    while [ ! -f "$filename" ]; do
-        echo "Waiting for $filename..."
-        sleep 0.25;
-    done
-    chmod 0777 "/racket/$port.sock"
-done
-
-export NGINX_WORKER_PROCESES=$(("$CORES" / 4))
-envsubst '$NGINX_WORKER_PROCESES' < /racket/config/nginx.conf.tpl > /racket/config/nginx.conf
-cat /racket/config/upstream.conf
-nginx -c /racket/config/nginx.conf
+/racket/bin/app --host 0.0.0.0 --port 8080