From patchwork Wed Jun 3 11:54:30 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 22541 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 8E0F227BBE1; Wed, 3 Jun 2020 12:55:08 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id CE64227BBE3 for ; Wed, 3 Jun 2020 12:55:06 +0100 (BST) Received: from localhost ([::1]:56030 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jgRz8-0001zD-EE for patchwork@mira.cbaines.net; Wed, 03 Jun 2020 07:55:06 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:40314) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jgRz4-0001yk-8u for guix-patches@gnu.org; Wed, 03 Jun 2020 07:55:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:58972) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jgRz3-0004TI-VN for guix-patches@gnu.org; Wed, 03 Jun 2020 07:55:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jgRz3-0001JZ-Uh for guix-patches@gnu.org; Wed, 03 Jun 2020 07:55:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40993] cuirass: Add build products download support. Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 03 Jun 2020 11:55:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40993 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: Ludovic =?utf-8?q?Court=C3=A8s?= Cc: Danny Milosavljevic , 40993@debbugs.gnu.org Received: via spool by 40993-submit@debbugs.gnu.org id=B40993.15911852805016 (code B ref 40993); Wed, 03 Jun 2020 11:55:01 +0000 Received: (at 40993) by debbugs.gnu.org; 3 Jun 2020 11:54:40 +0000 Received: from localhost ([127.0.0.1]:42279 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jgRyi-0001Im-A0 for submit@debbugs.gnu.org; Wed, 03 Jun 2020 07:54:40 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55584) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jgRyg-0001IR-Q5 for 40993@debbugs.gnu.org; Wed, 03 Jun 2020 07:54:39 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:40041) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jgRyb-0004QK-Cm; Wed, 03 Jun 2020 07:54:33 -0400 Received: from [2a01:e0a:fa:a50:7059:39d8:75e4:ec1a] (port=50632 helo=meru) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jgRya-00052g-R4; Wed, 03 Jun 2020 07:54:33 -0400 From: Mathieu Othacehe References: <87ees4uja7.fsf@gmail.com> <20200501120914.606ffe02@scratchpost.org> <874ksz4w21.fsf@gmail.com> <871ro3e4oa.fsf@gnu.org> Date: Wed, 03 Jun 2020 13:54:30 +0200 In-Reply-To: <871ro3e4oa.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Fri, 01 May 2020 23:17:09 +0200") Message-ID: <874krs74ax.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Hello Ludo, > I didn’t look at the other patches, but note that ‘sendfile’ blocks. > Since Cuirass is fiberized, you shouldn’t block a fiber. > > ‘guix publish’ doesn’t use Fibers but it shouldn’t block either while > sending a nar, so what it does is spawn a new thread for the ‘sendfile’ > call. Thanks for your help! I copied what's done in (guix scripts publish), except that I used "non-blocking" instead of using a plain "call-with-new-thread". If you could have a short look to the first patch (introducing build products) and tell me if the concept is ok for you, that would be great :) Thanks, Mathieu From c99cc0314b98e349a577f38870d1271a3f1c3a54 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 3 Jun 2020 13:41:30 +0200 Subject: [PATCH] cuirass: Use sendfiles instead of raw copies. * src/cuirass/http.scm (respond-file): Send the file name as 'x-raw-file header argument, instead of the raw file content, (respond-gzipped-file): ditto. Also set 'content-disposition header. * src/web/server/fiberized.scm (strip-headers, with-content-length): New procedures, (client-loop): Check if 'x-raw-file is set. If it's the case, use sendfiles to send the given file. Otherwise, keep the existing behaviour and send directly the received bytevector. --- src/cuirass/http.scm | 22 ++++++-------- src/web/server/fiberized.scm | 56 +++++++++++++++++++++++++++++------- 2 files changed, 54 insertions(+), 24 deletions(-) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 79fa246..0b2f056 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -246,19 +246,14 @@ Hydra format." "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd") (sxml->xml body port)))) - (define* (respond-file file - #:key name) + (define* (respond-file file) (let ((content-type (or (assoc-ref %file-mime-types (file-extension file)) '(application/octet-stream)))) (respond `((content-type . ,content-type) - ,@(if name - `((content-disposition - . (form-data (filename . ,name)))) - '())) - ;; FIXME: FILE is potentially big so it'd be better to not load - ;; it in memory and instead 'sendfile' it. - #:body (call-with-input-file file get-bytevector-all)))) + (content-disposition + . (form-data (filename . ,(basename file)))) + (x-raw-file . ,file))))) (define (respond-static-file path) ;; PATH is a list of path components @@ -273,10 +268,9 @@ Hydra format." (define (respond-gzipped-file file) ;; Return FILE with 'gzip' content-encoding. (respond `((content-type . (text/plain (charset . "UTF-8"))) - (content-encoding . (gzip))) - ;; FIXME: FILE is potentially big so it'd be better to not load - ;; it in memory and instead 'sendfile' it. - #:body (call-with-input-file file get-bytevector-all))) + (content-encoding . (gzip)) + (content-disposition . (form-data (filename . ,file))) + (x-raw-file . ,file)))) (define (respond-build-not-found build-id) (respond-json-with-error @@ -521,7 +515,7 @@ Hydra format." (('GET "download" id) (let ((path (db-get-build-product-path id))) - (respond-file path #:name (basename path)))) + (respond-file path))) (('GET "static" path ...) (respond-static-file path)) diff --git a/src/web/server/fiberized.scm b/src/web/server/fiberized.scm index 308b642..7769202 100644 --- a/src/web/server/fiberized.scm +++ b/src/web/server/fiberized.scm @@ -31,8 +31,12 @@ ;;; Code: (define-module (web server fiberized) - #:use-module ((srfi srfi-1) #:select (fold)) + #:use-module (guix build utils) + #:use-module ((srfi srfi-1) #:select (fold + alist-delete + alist-cons)) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:use-module (web http) #:use-module (web request) #:use-module (web response) @@ -41,7 +45,8 @@ #:use-module (ice-9 match) #:use-module (fibers) #:use-module (fibers channels) - #:use-module (cuirass logging)) + #:use-module (cuirass logging) + #:use-module (cuirass utils)) (define (make-default-socket family addr port) (let ((sock (socket PF_INET SOCK_STREAM 0))) @@ -92,6 +97,19 @@ ((0) (memq 'keep-alive (response-connection response))))) (else #f))))) +;; This procedure and the next one are copied from (guix scripts publish). +(define (strip-headers response) + "Return RESPONSE's headers minus 'Content-Length' and our internal headers." + (fold alist-delete + (response-headers response) + '(content-length x-raw-file x-nar-compression))) + +(define (with-content-length response length) + "Return RESPONSE with a 'content-length' header set to LENGTH." + (set-field response (response-headers) + (alist-cons 'content-length length + (strip-headers response)))) + (define (client-loop client have-request) ;; Always disable Nagle's algorithm, as we handle buffering ;; ourselves. @@ -119,14 +137,32 @@ #:headers '((content-length . 0))) #vu8())))) (lambda (response body) - (write-response response client) - (when body - (put-bytevector client body)) - (force-output client) - (if (and (keep-alive? response) - (not (eof-object? (peek-char client)))) - (loop) - (close-port client))))))))) + (match (assoc-ref (response-headers response) 'x-raw-file) + ((? string? file) + (non-blocking + (call-with-input-file file + (lambda (input) + (let* ((size (stat:size (stat input))) + (response (write-response + (with-content-length response size) + client)) + (output (response-port response))) + (setsockopt client SOL_SOCKET SO_SNDBUF + (* 128 1024)) + (if (file-port? output) + (sendfile output input size) + (dump-port input output)) + (close-port output) + (values)))))) + (#f (begin + (write-response response client) + (when body + (put-bytevector client body)) + (force-output client)) + (if (and (keep-alive? response) + (not (eof-object? (peek-char client)))) + (loop) + (close-port client))))))))))) (lambda (k . args) (catch #t (lambda () (close-port client)) -- 2.26.2