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