summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-05-18 21:19:49 +0200
committerLudovic Courtès <ludo@gnu.org>2017-05-20 10:17:36 +0200
commit4a628d57fc7956ae8a0fb167337d83ba66fe4f52 (patch)
treea0e9bf6ec2c05de11ea15bfd924ebfd1de05e136
parent36c99429a3638305c16f1e6f5e087daa174d249c (diff)
publish: Fix narinfo rendering for already-compressed items.
Fixes <http://bugs.gnu.org/26975>. Reported by Mark H Weaver <mhw@netris.org>. * guix/scripts/publish.scm (bake-narinfo+nar): Pass #f as the 2nd argument to 'stat' and properly handle #f. * tests/publish.scm (wait-for-file): New procedure. ("with cache"): Remove 'wait-for-file' procedure. ("with cache, uncompressed"): New test.
-rw-r--r--guix/scripts/publish.scm3
-rw-r--r--tests/publish.scm71
2 files changed, 65 insertions, 9 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 8da75cb825f..db7f6a957e5 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -481,7 +481,8 @@ requested using POOL."
481 (%private-key) 481 (%private-key)
482 #:nar-path nar-path 482 #:nar-path nar-path
483 #:compression compression 483 #:compression compression
484 #:file-size (stat:size (stat nar))) 484 #:file-size (and=> (stat nar #f)
485 stat:size))
485 port)))))) 486 port))))))
486 487
487;; XXX: Declare the 'Guix-Compression' HTTP header, which is in fact for 488;; XXX: Declare the 'Guix-Compression' HTTP header, which is in fact for
diff --git a/tests/publish.scm b/tests/publish.scm
index 268c3245511..31043f71fa0 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -98,6 +98,18 @@
98 (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port)) 98 (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
99 (loop))))) 99 (loop)))))
100 100
101(define (wait-for-file file)
102 ;; Wait until FILE shows up.
103 (let loop ((i 20))
104 (cond ((file-exists? file)
105 #t)
106 ((zero? i)
107 (error "file didn't show up" file))
108 (else
109 (pk 'wait-for-file file)
110 (sleep 1)
111 (loop (- i 1))))))
112
101;; Wait until the two servers are ready. 113;; Wait until the two servers are ready.
102(wait-until-ready 6789) 114(wait-until-ready 6789)
103 115
@@ -331,14 +343,6 @@ FileSize: ~a~%"
331 200) ;nar/… 343 200) ;nar/…
332 (call-with-temporary-directory 344 (call-with-temporary-directory
333 (lambda (cache) 345 (lambda (cache)
334 (define (wait-for-file file)
335 (let loop ((i 20))
336 (or (file-exists? file)
337 (begin
338 (pk 'wait-for-file file)
339 (sleep 1)
340 (loop (- i 1))))))
341
342 (let ((thread (with-separate-output-ports 346 (let ((thread (with-separate-output-ports
343 (call-with-new-thread 347 (call-with-new-thread
344 (lambda () 348 (lambda ()
@@ -384,4 +388,55 @@ FileSize: ~a~%"
384 (stat:size (stat nar))) 388 (stat:size (stat nar)))
385 (response-code uncompressed))))))))) 389 (response-code uncompressed)))))))))
386 390
391(unless (zlib-available?)
392 (test-skip 1))
393(let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
394 (random-text))))
395 (test-equal "with cache, uncompressed"
396 (list #f
397 `(("StorePath" . ,item)
398 ("URL" . ,(string-append "nar/" (basename item)))
399 ("Compression" . "none"))
400 200 ;nar/…
401 (path-info-nar-size
402 (query-path-info %store item)) ;FileSize
403 404) ;nar/gzip/…
404 (call-with-temporary-directory
405 (lambda (cache)
406 (let ((thread (with-separate-output-ports
407 (call-with-new-thread
408 (lambda ()
409 (guix-publish "--port=6796" "-C2"
410 (string-append "--cache=" cache)))))))
411 (wait-until-ready 6796)
412 (let* ((base "http://localhost:6796/")
413 (part (store-path-hash-part item))
414 (url (string-append base part ".narinfo"))
415 (cached (string-append cache "/none/"
416 (basename item) ".narinfo"))
417 (nar (string-append cache "/none/"
418 (basename item) ".nar"))
419 (response (http-get url)))
420 (and (= 404 (response-code response))
421
422 (wait-for-file cached)
423 (let* ((body (http-get-port url))
424 (compressed (http-get (string-append base "nar/gzip/"
425 (basename item))))
426 (uncompressed (http-get (string-append base "nar/"
427 (basename item))))
428 (narinfo (recutils->alist body)))
429 (list (file-exists? nar)
430 (filter (lambda (item)
431 (match item
432 (("Compression" . _) #t)
433 (("StorePath" . _) #t)
434 (("URL" . _) #t)
435 (_ #f)))
436 narinfo)
437 (response-code uncompressed)
438 (string->number
439 (assoc-ref narinfo "FileSize"))
440 (response-code compressed))))))))))
441
387(test-end "publish") 442(test-end "publish")