From c1719a0adf3fa7611b56ca4d75b3ac8cf5c9c8ac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 29 Apr 2022 17:56:30 +0200
Subject: publish: Send uncached narinfo replies from the main thread.

Fixes <https://issues.guix.gnu.org/54723>.
Reported by Guillaume Le Vaillant <glv@posteo.net>.

Regression introduced in f743f2046be2c5a338ab871ae8666d8f6de7440b.

With commit f743f2046be2c5a338ab871ae8666d8f6de7440b, responses to
pipelined GETs would end up being written concurrently by many threads.
Thus the body of those responses could be interleaved and garbled.

* guix/scripts/publish.scm: Revert
f743f2046be2c5a338ab871ae8666d8f6de7440b.
* tests/publish.scm ("/*.narinfo pipeline"): New test.
---
 tests/publish.scm | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

(limited to 'tests')

diff --git a/tests/publish.scm b/tests/publish.scm
index 47c5eabca0..efb5698bed 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -41,12 +41,15 @@
   #:autoload   (zstd) (call-with-zstd-input-port)
   #:use-module (web uri)
   #:use-module (web client)
+  #:use-module (web request)
   #:use-module (web response)
+  #:use-module ((guix http-client) #:select (http-multiple-get))
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
@@ -166,6 +169,26 @@ FileSize: ~a\n"
     (publish-uri
      (string-append "/" (store-path-hash-part %item) ".narinfo")))))
 
+(test-equal "/*.narinfo pipeline"
+  (make-list 500 200)
+  ;; Make sure clients can pipeline requests and correct responses, in the
+  ;; right order.  See <https://issues.guix.gnu.org/54723>.
+  (let* ((uri (string->uri (publish-uri
+                            (string-append "/"
+                                           (store-path-hash-part %item)
+                                           ".narinfo"))))
+         (_ expected (http-get uri #:streaming? #f #:decode-body? #f)))
+    (http-multiple-get (string->uri (publish-uri ""))
+                       (lambda (request response port result)
+                         (and (bytevector=? expected
+                                            (get-bytevector-n port
+                                                              (response-content-length
+                                                               response)))
+                              (cons (response-code response) result)))
+                       '()
+                       (make-list 500 (build-request uri))
+                       #:batch-size 77)))
+
 (test-equal "/*.narinfo with properly encoded '+' sign"
   ;; See <http://bugs.gnu.org/21888>.
   (let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
-- 
cgit v1.2.1