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
							
								
									acf82a1152
								
							
						
					
					
						commit
						ffa5e0a6d2
					
				
					 2 changed files with 65 additions and 9 deletions
				
			
		| 
						 | 
					@ -481,7 +481,8 @@ requested using POOL."
 | 
				
			||||||
                                   (%private-key)
 | 
					                                   (%private-key)
 | 
				
			||||||
                                   #:nar-path nar-path
 | 
					                                   #:nar-path nar-path
 | 
				
			||||||
                                   #:compression compression
 | 
					                                   #:compression compression
 | 
				
			||||||
                                   #:file-size (stat:size (stat nar)))
 | 
					                                   #:file-size (and=> (stat nar #f)
 | 
				
			||||||
 | 
					                                                      stat:size))
 | 
				
			||||||
                   port))))))
 | 
					                   port))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
;; XXX: Declare the 'Guix-Compression' HTTP header, which is in fact for
 | 
					;; 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))
 | 
					               (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
 | 
				
			||||||
        (loop)))))
 | 
					        (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 the two servers are ready.
 | 
				
			||||||
(wait-until-ready 6789)
 | 
					(wait-until-ready 6789)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -331,14 +343,6 @@ FileSize: ~a~%"
 | 
				
			||||||
        200)                                      ;nar/…
 | 
					        200)                                      ;nar/…
 | 
				
			||||||
  (call-with-temporary-directory
 | 
					  (call-with-temporary-directory
 | 
				
			||||||
   (lambda (cache)
 | 
					   (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
 | 
					     (let ((thread (with-separate-output-ports
 | 
				
			||||||
                    (call-with-new-thread
 | 
					                    (call-with-new-thread
 | 
				
			||||||
                     (lambda ()
 | 
					                     (lambda ()
 | 
				
			||||||
| 
						 | 
					@ -384,4 +388,55 @@ FileSize: ~a~%"
 | 
				
			||||||
                         (stat:size (stat nar)))
 | 
					                         (stat:size (stat nar)))
 | 
				
			||||||
                      (response-code uncompressed)))))))))
 | 
					                      (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")
 | 
					(test-end "publish")
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue