From patchwork Fri Aug 13 10:30:29 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 32098 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 6A30F27BC82; Fri, 13 Aug 2021 11:31:15 +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_H2,SPF_HELO_PASS,URIBL_BLOCKED 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 ESMTPS id 0519D27BC78 for ; Fri, 13 Aug 2021 11:31:15 +0100 (BST) Received: from localhost ([::1]:50660 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mEUT4-00016o-1q for patchwork@mira.cbaines.net; Fri, 13 Aug 2021 06:31:14 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43100) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mEUSs-000167-Sx for guix-patches@gnu.org; Fri, 13 Aug 2021 06:31:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:57229) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mEUSs-0001VW-Ai for guix-patches@gnu.org; Fri, 13 Aug 2021 06:31:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mEUSs-00072s-7t for guix-patches@gnu.org; Fri, 13 Aug 2021 06:31:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50040] [PATCH 1/2] publish: Defer narinfo string creation to the http-write. References: <20210813102800.805-1-othacehe@gnu.org> In-Reply-To: <20210813102800.805-1-othacehe@gnu.org> Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 13 Aug 2021 10:31:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50040 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50040@debbugs.gnu.org Cc: Mathieu Othacehe Received: via spool by 50040-submit@debbugs.gnu.org id=B50040.162885064227035 (code B ref 50040); Fri, 13 Aug 2021 10:31:02 +0000 Received: (at 50040) by debbugs.gnu.org; 13 Aug 2021 10:30:42 +0000 Received: from localhost ([127.0.0.1]:40539 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mEUSY-00071z-9R for submit@debbugs.gnu.org; Fri, 13 Aug 2021 06:30:42 -0400 Received: from eggs.gnu.org ([209.51.188.92]:54802) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mEUSX-00071U-4g for 50040@debbugs.gnu.org; Fri, 13 Aug 2021 06:30:41 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51804) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mEUSR-00014j-Sk for 50040@debbugs.gnu.org; Fri, 13 Aug 2021 06:30:35 -0400 Received: from [2a01:e0a:19b:d9a0:f2f7:a404:c3d3:f8b4] (port=44574 helo=localhost.localdomain) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mEUSR-0008GJ-Hq; Fri, 13 Aug 2021 06:30:35 -0400 From: Mathieu Othacehe Date: Fri, 13 Aug 2021 12:30:29 +0200 Message-Id: <20210813103030.1017-1-othacehe@gnu.org> X-Mailer: git-send-email 2.32.0 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 The "narinfo-string" procedure is expensive in term of IO operations and can take a while under IO pressure, such a GC collecting. Defer its call to a new thread created in the http-write procedure. Fixes: Partially fixes: * guix/scripts/publish.scm (render-narinfo): Defer the narinfo string creation to the http-write procedure. (compression->sexp, sexp->compression): New procedures. ("X-Nar-Compression"): Use them. ("X-Narinfo-Compressions"): New custom header. (strip-headers): Add the x-nar-path header. (http-write): Add narinfo on-the-fly creation support. It happens in a separated thread to prevent blocking the main thread. --- guix/scripts/publish.scm | 82 +++++++++++++++++++++++++++++++++------- 1 file changed, 69 insertions(+), 13 deletions(-) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 913cbd4fda..981ef8d267 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -24,6 +24,7 @@ #:use-module ((system repl server) #:prefix repl:) #:use-module (ice-9 binary-ports) #:use-module (ice-9 format) + #:use-module (ice-9 iconv) #:use-module (ice-9 match) #:use-module (ice-9 poll) #:use-module (ice-9 regex) @@ -409,15 +410,18 @@ appropriate duration. NAR-PATH specifies the prefix for nar URLs." (let ((store-path (hash-part->path store hash))) (if (string-null? store-path) (not-found request #:phrase "" #:ttl negative-ttl) - (values `((content-type . (application/x-nix-narinfo)) + (values `((content-type . (application/x-nix-narinfo + (charset . "UTF-8"))) + (x-nar-path . ,nar-path) + (x-narinfo-compressions . ,compressions) ,@(if ttl `((cache-control (max-age . ,ttl))) '())) - (cut display - (narinfo-string store store-path - #:nar-path nar-path - #:compressions compressions) - <>))))) + ;; Do not call narinfo-string directly here as it is an + ;; expensive call that could potentially block the main + ;; thread. Instead, create the narinfo string in the + ;; http-write procedure. + store-path)))) (define* (nar-cache-file directory item #:key (compression %no-compression)) @@ -672,19 +676,38 @@ requested using POOL." (link narinfo other))) others)))))) +(define (compression->sexp compression) + "Return the SEXP representation of COMPRESSION." + (match compression + (($ type level) + `(compression ,type ,level)))) + +(define (sexp->compression sexp) + "Turn the given SEXP into a record and return it." + (match sexp + (('compression type level) + (compression type level)))) + ;; XXX: Declare the 'X-Nar-Compression' HTTP header, which is in fact for ;; internal consumption: it allows us to pass the compression info to ;; 'http-write', as part of the workaround to . (declare-header! "X-Nar-Compression" (lambda (str) - (match (call-with-input-string str read) - (('compression type level) - (compression type level)))) + (sexp->compression + (call-with-input-string str read))) compression? (lambda (compression port) - (match compression - (($ type level) - (write `(compression ,type ,level) port))))) + (write (compression->sexp compression) port))) + +;; This header is used to pass the supported compressions to http-write in +;; order to format on-the-fly narinfo responses. +(declare-header! "X-Narinfo-Compressions" + (lambda (str) + (map sexp->compression + (call-with-input-string str read))) + (cut every compression? <>) + (lambda (compressions port) + (write (map compression->sexp compressions) port))) (define* (render-nar store request store-item #:key (compression %no-compression)) @@ -839,7 +862,8 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")." "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))) + '(content-length x-raw-file x-nar-compression + x-narinfo-compressions x-nar-path))) (define (sans-content-length response) "Return RESPONSE without its 'content-length' header." @@ -973,6 +997,38 @@ blocking." (unless keep-alive? (close-port client))) (values)))))) + (('application/x-nix-narinfo . _) + (let ((compressions (assoc-ref (response-headers response) + 'x-narinfo-compressions)) + (nar-path (assoc-ref (response-headers response) + 'x-nar-path))) + (if nar-path + (begin + (when (keep-alive? response) + (keep-alive client)) + (call-with-new-thread + (lambda () + (set-thread-name "publish narinfo") + (let* ((narinfo + (with-store store + (narinfo-string store (utf8->string body) + #:nar-path nar-path + #:compressions compressions))) + (narinfo-bv (string->bytevector narinfo "UTF-8")) + (narinfo-length + (bytevector-length narinfo-bv)) + (response (write-response + (with-content-length response + narinfo-length) + client)) + (output (response-port response))) + (configure-socket client) + (put-bytevector output narinfo-bv) + (force-output output) + (unless (keep-alive? response) + (close-port output)) + (values))))) + (%http-write server client response body)))) (_ (match (assoc-ref (response-headers response) 'x-raw-file) ((? string? file)