1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
3 ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 ;; Avoid interference.
21 (unsetenv "http_proxy")
23 (define-module (test-publish)
24 #:use-module (guix scripts publish)
25 #:use-module (guix tests)
26 #:use-module (guix config)
27 #:use-module (guix utils)
28 #:use-module (gcrypt hash)
29 #:use-module (guix store)
30 #:use-module (guix derivations)
31 #:use-module (guix gexp)
32 #:use-module (guix base32)
33 #:use-module (guix base64)
34 #:use-module ((guix records) #:select (recutils->alist))
35 #:use-module ((guix serialization) #:select (restore-file))
36 #:use-module (gcrypt pk-crypto)
37 #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
38 #:use-module (guix zlib)
39 #:use-module (guix lzlib)
40 #:use-module (web uri)
41 #:use-module (web client)
42 #:use-module (web response)
43 #:use-module (rnrs bytevectors)
44 #:use-module (ice-9 binary-ports)
45 #:use-module (srfi srfi-1)
46 #:use-module (srfi srfi-26)
47 #:use-module (srfi srfi-64)
48 #:use-module (ice-9 threads)
49 #:use-module (ice-9 format)
50 #:use-module (ice-9 match)
51 #:use-module (ice-9 rdelim))
54 (open-connection-for-tests))
56 (define %reference (add-text-to-store %store "ref" "foo"))
58 (define %item (add-text-to-store %store "item" "bar" (list %reference)))
60 (define (http-get-body uri)
61 (call-with-values (lambda () (http-get uri))
62 (lambda (response body) body)))
64 (define (http-get-port uri)
65 (let ((socket (open-socket-for-uri uri)))
66 ;; Make sure to use an unbuffered port so that we can then peek at the
67 ;; underlying file descriptor via 'call-with-gzip-input-port'.
68 (setvbuf socket 'none)
71 (http-get uri #:port socket #:streaming? #t))
72 (lambda (response port)
73 ;; Don't (setvbuf port 'none) because of <http://bugs.gnu.org/19610>
74 ;; (PORT might be a custom binary input port).
77 (define (publish-uri route)
78 (string-append "http://localhost:6789" route))
80 (define-syntax-rule (with-separate-output-ports exp ...)
81 ;; Since ports aren't thread-safe in Guile 2.0, duplicate the output and
82 ;; error ports to make sure the two threads don't end up stepping on each
84 (with-output-to-port (duplicate-port (current-output-port) "w")
86 (with-error-to-port (duplicate-port (current-error-port) "w")
90 ;; Run a local publishing server in a separate thread.
91 (with-separate-output-ports
94 (guix-publish "--port=6789" "-C0")))) ;attempt to avoid port collision
96 (define (wait-until-ready port)
97 ;; Wait until the server is accepting connections.
98 (let ((conn (socket PF_INET SOCK_STREAM 0)))
100 (unless (false-if-exception
101 (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
104 (define (wait-for-file file)
105 ;; Wait until FILE shows up.
107 (cond ((file-exists? file)
110 (error "file didn't show up" file))
112 (pk 'wait-for-file file)
116 (define %gzip-magic-bytes
117 ;; Magic bytes of gzip file.
120 ;; Wait until the two servers are ready.
121 (wait-until-ready 6789)
123 ;; Initialize the public/private key SRFI-39 parameters.
124 (%public-key (read-file-sexp %public-key-file))
125 (%private-key (read-file-sexp %private-key-file))
128 (test-begin "publish")
130 (test-equal "/nix-cache-info"
131 (format #f "StoreDir: ~a\nWantMassQuery: 0\nPriority: 100\n"
133 (http-get-body (publish-uri "/nix-cache-info")))
135 (test-equal "/*.narinfo"
136 (let* ((info (query-path-info %store %item))
148 (path-info-nar-size info)
149 (bytevector->nix-base32-string
150 (path-info-hash info))
151 (path-info-nar-size info)
152 (basename (first (path-info-references info)))))
153 (signature (base64-encode
155 (canonical-sexp->string
156 (signed-string unsigned-info))))))
157 (format #f "~aSignature: 1;~a;~a~%"
158 unsigned-info (gethostname) signature))
162 (string-append "/" (store-path-hash-part %item) ".narinfo")))))
164 (test-equal "/*.narinfo with properly encoded '+' sign"
165 ;; See <http://bugs.gnu.org/21888>.
166 (let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
167 (info (query-path-info %store item))
178 (uri-encode (basename item))
179 (path-info-nar-size info)
180 (bytevector->nix-base32-string
181 (path-info-hash info))
182 (path-info-nar-size info)))
183 (signature (base64-encode
185 (canonical-sexp->string
186 (signed-string unsigned-info))))))
187 (format #f "~aSignature: 1;~a;~a~%"
188 unsigned-info (gethostname) signature))
190 (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
194 (string-append "/" (store-path-hash-part item) ".narinfo"))))))
198 (call-with-temporary-output-file
200 (let ((nar (utf8->string
203 (string-append "/nar/" (basename %item)))))))
204 (call-with-input-string nar (cut restore-file <> temp)))
205 (call-with-input-file temp read-string))))
207 (unless (zlib-available?)
209 (test-equal "/nar/gzip/*"
211 (call-with-temporary-output-file
213 (let ((nar (http-get-port
215 (string-append "/nar/gzip/" (basename %item))))))
216 (call-with-gzip-input-port nar
217 (cut restore-file <> temp)))
218 (call-with-input-file temp read-string))))
220 (unless (zlib-available?)
222 (test-equal "/nar/gzip/* is really gzip"
224 ;; Since 'gzdopen' (aka. 'call-with-gzip-input-port') transparently reads
225 ;; uncompressed gzip, the test above doesn't check whether it's actually
226 ;; gzip. This is what this test does. See <https://bugs.gnu.org/30184>.
227 (let ((nar (http-get-port
229 (string-append "/nar/gzip/" (basename %item))))))
230 (get-bytevector-n nar (bytevector-length %gzip-magic-bytes))))
232 (unless (lzlib-available?)
234 (test-equal "/nar/lzip/*"
236 (call-with-temporary-output-file
238 (let ((nar (http-get-port
240 (string-append "/nar/lzip/" (basename %item))))))
241 (call-with-lzip-input-port nar
242 (cut restore-file <> temp)))
243 (call-with-input-file temp read-string))))
245 (unless (zlib-available?)
247 (test-equal "/*.narinfo with compression"
248 `(("StorePath" . ,%item)
249 ("URL" . ,(string-append "nar/gzip/" (basename %item)))
250 ("Compression" . "gzip"))
251 (let ((thread (with-separate-output-ports
252 (call-with-new-thread
254 (guix-publish "--port=6799" "-C5"))))))
255 (wait-until-ready 6799)
256 (let* ((url (string-append "http://localhost:6799/"
257 (store-path-hash-part %item) ".narinfo"))
258 (body (http-get-port url)))
259 (filter (lambda (item)
261 (("Compression" . _) #t)
262 (("StorePath" . _) #t)
265 (recutils->alist body)))))
267 (unless (lzlib-available?)
269 (test-equal "/*.narinfo with lzip compression"
270 `(("StorePath" . ,%item)
271 ("URL" . ,(string-append "nar/lzip/" (basename %item)))
272 ("Compression" . "lzip"))
273 (let ((thread (with-separate-output-ports
274 (call-with-new-thread
276 (guix-publish "--port=6790" "-Clzip"))))))
277 (wait-until-ready 6790)
278 (let* ((url (string-append "http://localhost:6790/"
279 (store-path-hash-part %item) ".narinfo"))
280 (body (http-get-port url)))
281 (filter (lambda (item)
283 (("Compression" . _) #t)
284 (("StorePath" . _) #t)
287 (recutils->alist body)))))
289 (unless (zlib-available?)
291 (test-equal "/*.narinfo for a compressed file"
292 '("none" "nar") ;compression-less nar
293 ;; Assume 'guix publish -C' is already running on port 6799.
294 (let* ((item (add-text-to-store %store "fake.tar.gz"
295 "This is a fake compressed file."))
296 (url (string-append "http://localhost:6799/"
297 (store-path-hash-part item) ".narinfo"))
298 (body (http-get-port url))
299 (info (recutils->alist body)))
300 (list (assoc-ref info "Compression")
301 (dirname (assoc-ref info "URL")))))
303 (unless (and (zlib-available?) (lzlib-available?))
305 (test-equal "/*.narinfo with lzip + gzip"
306 `((("StorePath" . ,%item)
307 ("URL" . ,(string-append "nar/gzip/" (basename %item)))
308 ("Compression" . "gzip")
309 ("URL" . ,(string-append "nar/lzip/" (basename %item)))
310 ("Compression" . "lzip"))
313 (call-with-temporary-directory
315 (let ((thread (with-separate-output-ports
316 (call-with-new-thread
318 (guix-publish "--port=6793" "-Cgzip:2" "-Clzip:2"))))))
319 (wait-until-ready 6793)
320 (let* ((base "http://localhost:6793/")
321 (part (store-path-hash-part %item))
322 (url (string-append base part ".narinfo"))
323 (body (http-get-port url)))
324 (list (take (recutils->alist body) 5)
326 (http-get (string-append base "nar/gzip/"
329 (http-get (string-append base "nar/lzip/"
330 (basename %item))))))))))
332 (test-equal "custom nar path"
333 ;; Serve nars at /foo/bar/chbouib instead of /nar.
334 (list `(("StorePath" . ,%item)
335 ("URL" . ,(string-append "foo/bar/chbouib/" (basename %item)))
336 ("Compression" . "none"))
339 (let ((thread (with-separate-output-ports
340 (call-with-new-thread
342 (guix-publish "--port=6798" "-C0"
343 "--nar-path=///foo/bar//chbouib/"))))))
344 (wait-until-ready 6798)
345 (let* ((base "http://localhost:6798/")
346 (part (store-path-hash-part %item))
347 (url (string-append base part ".narinfo"))
348 (nar-url (string-append base "foo/bar/chbouib/"
350 (body (http-get-port url)))
351 (list (filter (lambda (item)
353 (("Compression" . _) #t)
354 (("StorePath" . _) #t)
357 (recutils->alist body))
358 (response-code (http-get nar-url))
360 (http-get (string-append base "nar/" (basename %item))))))))
362 (test-equal "/nar/ with properly encoded '+' sign"
364 (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
365 (call-with-temporary-output-file
367 (let ((nar (utf8->string
370 (string-append "/nar/" (uri-encode (basename item))))))))
371 (call-with-input-string nar (cut restore-file <> temp)))
372 (call-with-input-file temp read-string)))))
374 (test-equal "/nar/invalid"
377 (call-with-output-file (string-append (%store-prefix) "/invalid")
379 (display "This file is not a valid store item." port)))
380 (response-code (http-get (publish-uri (string-append "/nar/invalid"))))))
382 (test-equal "/file/NAME/sha256/HASH"
384 (let* ((data "Hello, Guix world!")
385 (hash (call-with-input-string data port-sha256))
386 (drv (run-with-store %store
387 (gexp->derivation "the-file.txt"
388 #~(call-with-output-file #$output
390 (display #$data port)))
393 (out (build-derivations %store (list drv))))
397 (string-append "/file/the-file.txt/sha256/"
398 (bytevector->nix-base32-string hash)))))))
400 (test-equal "/file/NAME/sha256/INVALID-NIX-BASE32-STRING"
402 (let ((uri (publish-uri
403 "/file/the-file.txt/sha256/not-a-nix-base32-string")))
404 (response-code (http-get uri))))
406 (test-equal "/file/NAME/sha256/INVALID-HASH"
408 (let ((uri (publish-uri
409 (string-append "/file/the-file.txt/sha256/"
410 (bytevector->nix-base32-string
411 (call-with-input-string "" port-sha256))))))
412 (response-code (http-get uri))))
414 (unless (zlib-available?)
416 (test-equal "with cache"
418 `(("StorePath" . ,%item)
419 ("URL" . ,(string-append "nar/gzip/" (basename %item)))
420 ("Compression" . "gzip"))
425 (call-with-temporary-directory
427 (let ((thread (with-separate-output-ports
428 (call-with-new-thread
430 (guix-publish "--port=6797" "-C2"
431 (string-append "--cache=" cache)))))))
432 (wait-until-ready 6797)
433 (let* ((base "http://localhost:6797/")
434 (part (store-path-hash-part %item))
435 (url (string-append base part ".narinfo"))
436 (nar-url (string-append base "nar/gzip/" (basename %item)))
437 (cached (string-append cache "/gzip/" (basename %item)
439 (nar (string-append cache "/gzip/"
440 (basename %item) ".nar"))
441 (response (http-get url)))
442 (and (= 404 (response-code response))
444 ;; We should get an explicitly short TTL for 404 in this case
445 ;; because it's going to become 200 shortly.
446 (match (assq-ref (response-headers response) 'cache-control)
450 (wait-for-file cached)
451 (let* ((body (http-get-port url))
452 (compressed (http-get nar-url))
453 (uncompressed (http-get (string-append base "nar/"
455 (narinfo (recutils->alist body)))
456 (list (file-exists? nar)
457 (filter (lambda (item)
459 (("Compression" . _) #t)
460 (("StorePath" . _) #t)
464 (response-code compressed)
465 (= (response-content-length compressed)
466 (stat:size (stat nar)))
468 (assoc-ref narinfo "FileSize"))
469 (stat:size (stat nar)))
470 (response-code uncompressed)))))))))
472 (unless (and (zlib-available?) (lzlib-available?))
474 (test-equal "with cache, lzip + gzip"
476 (call-with-temporary-directory
478 (let ((thread (with-separate-output-ports
479 (call-with-new-thread
481 (guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2"
482 (string-append "--cache=" cache)))))))
483 (wait-until-ready 6794)
484 (let* ((base "http://localhost:6794/")
485 (part (store-path-hash-part %item))
486 (url (string-append base part ".narinfo"))
487 (nar-url (cute string-append "nar/" <> "/"
489 (cached (cute string-append cache "/" <> "/"
490 (basename %item) ".narinfo"))
491 (nar (cute string-append cache "/" <> "/"
492 (basename %item) ".nar"))
493 (response (http-get url)))
494 (wait-for-file (cached "gzip"))
495 (let* ((body (http-get-port url))
496 (narinfo (recutils->alist body))
497 (uncompressed (string-append base "nar/"
499 (and (file-exists? (nar "gzip"))
500 (file-exists? (nar "lzip"))
501 (equal? (take (pk 'narinfo/gzip+lzip narinfo) 7)
502 `(("StorePath" . ,%item)
503 ("URL" . ,(nar-url "gzip"))
504 ("Compression" . "gzip")
505 ("FileSize" . ,(number->string
506 (stat:size (stat (nar "gzip")))))
507 ("URL" . ,(nar-url "lzip"))
508 ("Compression" . "lzip")
509 ("FileSize" . ,(number->string
510 (stat:size (stat (nar "lzip")))))))
512 (http-get (string-append base (nar-url "gzip"))))
514 (http-get (string-append base (nar-url "lzip"))))
516 (http-get uncompressed))))))))))
518 (unless (zlib-available?)
520 (let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
522 (test-equal "with cache, uncompressed"
524 (* 42 3600) ;TTL on narinfo
525 `(("StorePath" . ,item)
526 ("URL" . ,(string-append "nar/" (basename item)))
527 ("Compression" . "none"))
529 (* 42 3600) ;TTL on nar/…
531 (query-path-info %store item)) ;FileSize
533 (call-with-temporary-directory
535 (let ((thread (with-separate-output-ports
536 (call-with-new-thread
538 (guix-publish "--port=6796" "-C2" "--ttl=42h"
539 (string-append "--cache=" cache)))))))
540 (wait-until-ready 6796)
541 (let* ((base "http://localhost:6796/")
542 (part (store-path-hash-part item))
543 (url (string-append base part ".narinfo"))
544 (cached (string-append cache "/none/"
545 (basename item) ".narinfo"))
546 (nar (string-append cache "/none/"
547 (basename item) ".nar"))
548 (response (http-get url)))
549 (and (= 404 (response-code response))
551 (wait-for-file cached)
552 (let* ((response (http-get url))
553 (body (http-get-port url))
554 (compressed (http-get (string-append base "nar/gzip/"
556 (uncompressed (http-get (string-append base "nar/"
558 (narinfo (recutils->alist body)))
559 (list (file-exists? nar)
560 (match (assq-ref (response-headers response)
562 ((('max-age . ttl)) ttl)
565 (filter (lambda (item)
567 (("Compression" . _) #t)
568 (("StorePath" . _) #t)
572 (response-code uncompressed)
573 (match (assq-ref (response-headers uncompressed)
575 ((('max-age . ttl)) ttl)
579 (assoc-ref narinfo "FileSize"))
580 (response-code compressed))))))))))
582 (test-equal "with cache, vanishing item" ;<https://bugs.gnu.org/33897>
584 (call-with-temporary-directory
586 (let ((thread (with-separate-output-ports
587 (call-with-new-thread
589 (guix-publish "--port=6795"
590 (string-append "--cache=" cache)))))))
591 (wait-until-ready 6795)
593 ;; Make sure that, even if ITEM disappears, we're still able to fetch
595 (let* ((base "http://localhost:6795/")
596 (item (add-text-to-store %store "random" (random-text)))
597 (part (store-path-hash-part item))
598 (url (string-append base part ".narinfo"))
599 (cached (string-append cache
600 (if (zlib-available?)
604 (response (http-get url)))
605 (and (= 404 (response-code response))
606 (wait-for-file cached)
608 (delete-paths %store (list item))
609 (response-code (pk 'response (http-get url))))))))))
611 (test-equal "/log/NAME"
612 `(200 #t application/x-bzip2)
613 (let ((drv (run-with-store %store
614 (gexp->derivation "with-log"
615 #~(call-with-output-file #$output
617 (display "Hello, build log!"
618 (current-error-port))
619 (display #$(random-text) port)))))))
620 (build-derivations %store (list drv))
621 (let* ((response (http-get
622 (publish-uri (string-append "/log/"
623 (basename (derivation->output-path drv))))
625 (base (basename (derivation-file-name drv)))
626 (log (string-append (dirname %state-directory)
627 "/log/guix/drvs/" (string-take base 2)
628 "/" (string-drop base 2) ".bz2")))
629 (list (response-code response)
630 (= (response-content-length response) (stat:size (stat log)))
631 (first (response-content-type response))))))
633 (test-equal "/log/NAME not found"
635 (let ((uri (publish-uri "/log/does-not-exist")))
636 (response-code (http-get uri))))
638 (test-equal "non-GET query"
640 (let ((path (string-append "/" (store-path-hash-part %item)
643 (list (http-get (publish-uri path))
644 (http-post (publish-uri path))))))