diff options
| -rw-r--r-- | guix/scripts/publish.scm | 3 | ||||
| -rw-r--r-- | tests/publish.scm | 71 |
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") |
