diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-02-14 16:48:53 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-02-14 16:51:29 +0100 |
commit | b71f0cdca5aeb82e5eb24f54b32e3f09fee22bad (patch) | |
tree | bbffd9994995e395ec50b8a08566eb9332b3aab0 /src | |
parent | 1f31134d33ba6b30e375c9debe792a6c85363313 (diff) | |
download | cuirass-b71f0cdca5aeb82e5eb24f54b32e3f09fee22bad.tar cuirass-b71f0cdca5aeb82e5eb24f54b32e3f09fee22bad.tar.gz |
Revert "http: Process client connections really concurrently."
This reverts commit c47dfdf82b4be62501a7932eaec4c124566a1829.
Processing connections concurrently would require having separate
database handles. See
<https://lists.gnu.org/archive/html/guix-devel/2018-02/msg00206.html>.
Diffstat (limited to 'src')
-rw-r--r-- | src/cuirass/http.scm | 33 |
1 files changed, 8 insertions, 25 deletions
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index ef763ef..3856b1d 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -22,15 +22,12 @@ #:use-module (cuirass database) #:use-module (cuirass utils) #:use-module (cuirass logging) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (json) #:use-module (web request) #:use-module (web response) - #:use-module ((web server) #:hide (run-server)) + #:use-module (web server) #:use-module (web uri) - #:use-module (fibers) #:export (run-cuirass-server)) (define (build->hydra-build build) @@ -213,24 +210,10 @@ ;; thread creations and calls 'run-fibers' by itself, which isn't ;; necessary here (and harmful). ;; - ;; In addition, we roll our own instead of using Guile's 'run-server' and - ;; 'serve-one-client'. The key thing here is that we spawn a fiber to - ;; process each client request and then directly go back waiting for the - ;; next client (conversely, Guile's 'run-server' loop processes clients - ;; one after another, sequentially.) We can do that because we don't - ;; maintain any state across connections. - ;; - ;; XXX: We don't do 'call-with-sigint' like 'run-server' does. - (let* ((impl (lookup-server-impl 'fiberized)) - (server (open-server impl `(#:host ,address #:port ,port)))) - (let loop () - (let-values (((client request body) - (read-client impl server))) - ;; Spawn a fiber to handle REQUEST and reply to CLIENT. - (spawn-fiber - (lambda () - (let-values (((response body state) - (handle-request (cut url-handler <> <> db) - request body '()))) - (write-client impl server client response body))))) - (loop))))) + ;; XXX: 'run-server' serializes client request processing, making sure + ;; only one client is served at a time. This is not ideal, but processing + ;; things concurrently would require having several database handles. + (run-server url-handler + 'fiberized + `(#:host ,address #:port ,port) + db))) |