[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/05: publish: Serve /nar requests in a separate thread.
From: |
Ludovic Courtès |
Subject: |
03/05: publish: Serve /nar requests in a separate thread. |
Date: |
Sun, 19 Jul 2015 23:26:29 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit 7f23fb00882dd65b4cad51a9cf52d5f86b32fdb4
Author: Ludovic Courtès <address@hidden>
Date: Sun Jul 19 23:58:37 2015 +0200
publish: Serve /nar requests in a separate thread.
* guix/scripts/publish.scm (%http-write): New variable.
(http-write): New procedure.
(concurrent-http-server): New variable.
(run-publish-server): Use it.
---
guix/scripts/publish.scm | 33 ++++++++++++++++++++++++++++++++-
1 files changed, 32 insertions(+), 1 deletions(-)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index e0226f3..fd1f9f8 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <address@hidden>
+;;; Copyright © 2015 Ludovic Courtès <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -227,6 +228,36 @@ is invalid."
example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(split-and-decode-uri-path (uri-path (request-uri request))))
+
+;;;
+;;; Server.
+;;;
+
+(define %http-write
+ (@@ (web server http) http-write))
+
+(define (http-write server client response body)
+ "Write RESPONSE and BODY to CLIENT, possibly in a separate thread to avoid
+blocking."
+ (match (response-content-type response)
+ (('application/x-nix-archive . _)
+ ;; Sending the the whole archive can take time so do it in a separate
+ ;; thread so that the main thread can keep working in the meantime.
+ (call-with-new-thread
+ (lambda ()
+ (%http-write server client response body))))
+ (_
+ ;; Handle other responses sequentially.
+ (%http-write server client response body))))
+
+(define-server-impl concurrent-http-server
+ ;; A variant of Guile's built-in HTTP server that offloads possibly long
+ ;; responses to a different thread.
+ (@@ (web server http) http-open)
+ (@@ (web server http) http-read)
+ http-write
+ (@@ (web server http) http-close))
+
(define (make-request-handler store)
(lambda (request body)
(format #t "~a ~a~%"
@@ -248,7 +279,7 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(define (run-publish-server socket store)
(run-server (make-request-handler store)
- 'http
+ concurrent-http-server
`(#:socket ,socket)))
(define (open-server-socket address)