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.
This commit is contained in:
parent
36c99429a3
commit
4a628d57fc
|
@ -481,7 +481,8 @@ requested using POOL."
|
|||
(%private-key)
|
||||
#:nar-path nar-path
|
||||
#:compression compression
|
||||
#:file-size (stat:size (stat nar)))
|
||||
#:file-size (and=> (stat nar #f)
|
||||
stat:size))
|
||||
port))))))
|
||||
|
||||
;; XXX: Declare the 'Guix-Compression' HTTP header, which is in fact for
|
||||
|
|
|
@ -98,6 +98,18 @@
|
|||
(connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
|
||||
(loop)))))
|
||||
|
||||
(define (wait-for-file file)
|
||||
;; Wait until FILE shows up.
|
||||
(let loop ((i 20))
|
||||
(cond ((file-exists? file)
|
||||
#t)
|
||||
((zero? i)
|
||||
(error "file didn't show up" file))
|
||||
(else
|
||||
(pk 'wait-for-file file)
|
||||
(sleep 1)
|
||||
(loop (- i 1))))))
|
||||
|
||||
;; Wait until the two servers are ready.
|
||||
(wait-until-ready 6789)
|
||||
|
||||
|
@ -331,14 +343,6 @@ FileSize: ~a~%"
|
|||
200) ;nar/…
|
||||
(call-with-temporary-directory
|
||||
(lambda (cache)
|
||||
(define (wait-for-file file)
|
||||
(let loop ((i 20))
|
||||
(or (file-exists? file)
|
||||
(begin
|
||||
(pk 'wait-for-file file)
|
||||
(sleep 1)
|
||||
(loop (- i 1))))))
|
||||
|
||||
(let ((thread (with-separate-output-ports
|
||||
(call-with-new-thread
|
||||
(lambda ()
|
||||
|
@ -384,4 +388,55 @@ FileSize: ~a~%"
|
|||
(stat:size (stat nar)))
|
||||
(response-code uncompressed)))))))))
|
||||
|
||||
(unless (zlib-available?)
|
||||
(test-skip 1))
|
||||
(let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
|
||||
(random-text))))
|
||||
(test-equal "with cache, uncompressed"
|
||||
(list #f
|
||||
`(("StorePath" . ,item)
|
||||
("URL" . ,(string-append "nar/" (basename item)))
|
||||
("Compression" . "none"))
|
||||
200 ;nar/…
|
||||
(path-info-nar-size
|
||||
(query-path-info %store item)) ;FileSize
|
||||
404) ;nar/gzip/…
|
||||
(call-with-temporary-directory
|
||||
(lambda (cache)
|
||||
(let ((thread (with-separate-output-ports
|
||||
(call-with-new-thread
|
||||
(lambda ()
|
||||
(guix-publish "--port=6796" "-C2"
|
||||
(string-append "--cache=" cache)))))))
|
||||
(wait-until-ready 6796)
|
||||
(let* ((base "http://localhost:6796/")
|
||||
(part (store-path-hash-part item))
|
||||
(url (string-append base part ".narinfo"))
|
||||
(cached (string-append cache "/none/"
|
||||
(basename item) ".narinfo"))
|
||||
(nar (string-append cache "/none/"
|
||||
(basename item) ".nar"))
|
||||
(response (http-get url)))
|
||||
(and (= 404 (response-code response))
|
||||
|
||||
(wait-for-file cached)
|
||||
(let* ((body (http-get-port url))
|
||||
(compressed (http-get (string-append base "nar/gzip/"
|
||||
(basename item))))
|
||||
(uncompressed (http-get (string-append base "nar/"
|
||||
(basename item))))
|
||||
(narinfo (recutils->alist body)))
|
||||
(list (file-exists? nar)
|
||||
(filter (lambda (item)
|
||||
(match item
|
||||
(("Compression" . _) #t)
|
||||
(("StorePath" . _) #t)
|
||||
(("URL" . _) #t)
|
||||
(_ #f)))
|
||||
narinfo)
|
||||
(response-code uncompressed)
|
||||
(string->number
|
||||
(assoc-ref narinfo "FileSize"))
|
||||
(response-code compressed))))))))))
|
||||
|
||||
(test-end "publish")
|
||||
|
|
Loading…
Reference in New Issue