summaryrefslogtreecommitdiff
path: root/src/cuirass/http.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-02-14 16:48:53 +0100
committerLudovic Courtès <ludo@gnu.org>2018-02-14 16:51:29 +0100
commitb71f0cdca5aeb82e5eb24f54b32e3f09fee22bad (patch)
treebbffd9994995e395ec50b8a08566eb9332b3aab0 /src/cuirass/http.scm
parent1f31134d33ba6b30e375c9debe792a6c85363313 (diff)
downloadcuirass-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/cuirass/http.scm')
-rw-r--r--src/cuirass/http.scm33
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)))