1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
4 ;;; This file is part of GNU Guix.
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 ;; Avoid interference.
20 (unsetenv "http_proxy")
22 (define-module (test-publish)
23 #:use-module (guix scripts publish)
24 #:use-module (guix tests)
25 #:use-module (guix config)
26 #:use-module (guix utils)
27 #:use-module (guix hash)
28 #:use-module (guix store)
29 #:use-module (guix derivations)
30 #:use-module (guix gexp)
31 #:use-module (guix base32)
32 #:use-module (guix base64)
33 #:use-module ((guix records) #:select (recutils->alist))
34 #:use-module ((guix serialization) #:select (restore-file))
35 #:use-module (guix pk-crypto)
36 #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
37 #:use-module (guix zlib)
38 #:use-module (web uri)
39 #:use-module (web client)
40 #:use-module (web response)
41 #:use-module (rnrs bytevectors)
42 #:use-module (ice-9 binary-ports)
43 #:use-module (srfi srfi-1)
44 #:use-module (srfi srfi-26)
45 #:use-module (srfi srfi-64)
46 #:use-module (ice-9 format)
47 #:use-module (ice-9 match)
48 #:use-module (ice-9 rdelim))
51 (open-connection-for-tests))
53 (define %reference (add-text-to-store %store "ref" "foo"))
55 (define %item (add-text-to-store %store "item" "bar" (list %reference)))
57 (define (http-get-body uri)
58 (call-with-values (lambda () (http-get uri))
59 (lambda (response body) body)))
61 (define (http-get-port uri)
62 (let ((socket (open-socket-for-uri uri)))
63 ;; Make sure to use an unbuffered port so that we can then peek at the
64 ;; underlying file descriptor via 'call-with-gzip-input-port'.
65 (setvbuf socket _IONBF)
68 (http-get uri #:port socket #:streaming? #t))
69 (lambda (response port)
70 ;; Don't (setvbuf port _IONBF) because of <http://bugs.gnu.org/19610>
71 ;; (PORT might be a custom binary input port).
74 (define (publish-uri route)
75 (string-append "http://localhost:6789" route))
77 (define-syntax-rule (with-separate-output-ports exp ...)
78 ;; Since ports aren't thread-safe in Guile 2.0, duplicate the output and
79 ;; error ports to make sure the two threads don't end up stepping on each
81 (with-output-to-port (duplicate-port (current-output-port) "w")
83 (with-error-to-port (duplicate-port (current-error-port) "w")
87 ;; Run a local publishing server in a separate thread.
88 (with-separate-output-ports
91 (guix-publish "--port=6789" "-C0")))) ;attempt to avoid port collision
93 (define (wait-until-ready port)
94 ;; Wait until the server is accepting connections.
95 (let ((conn (socket PF_INET SOCK_STREAM 0)))
97 (unless (false-if-exception
98 (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
101 (define (wait-for-file file)
102 ;; Wait until FILE shows up.
104 (cond ((file-exists? file)
107 (error "file didn't show up" file))
109 (pk 'wait-for-file file)
113 ;; Wait until the two servers are ready.
114 (wait-until-ready 6789)
116 ;; Initialize the public/private key SRFI-39 parameters.
117 (%public-key (read-file-sexp %public-key-file))
118 (%private-key (read-file-sexp %private-key-file))
121 (test-begin "publish")
123 (test-equal "/nix-cache-info"
124 (format #f "StoreDir: ~a\nWantMassQuery: 0\nPriority: 100\n"
126 (http-get-body (publish-uri "/nix-cache-info")))
128 (test-equal "/*.narinfo"
129 (let* ((info (query-path-info %store %item))
141 (bytevector->nix-base32-string
142 (path-info-hash info))
143 (path-info-nar-size info)
144 (basename (first (path-info-references info)))
145 (path-info-nar-size info)))
146 (signature (base64-encode
148 (canonical-sexp->string
149 ((@@ (guix scripts publish) signed-string)
151 (format #f "~aSignature: 1;~a;~a~%"
152 unsigned-info (gethostname) signature))
156 (string-append "/" (store-path-hash-part %item) ".narinfo")))))
158 (test-equal "/*.narinfo with properly encoded '+' sign"
159 ;; See <http://bugs.gnu.org/21888>.
160 (let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
161 (info (query-path-info %store item))
172 (uri-encode (basename item))
173 (bytevector->nix-base32-string
174 (path-info-hash info))
175 (path-info-nar-size info)
176 (path-info-nar-size info)))
177 (signature (base64-encode
179 (canonical-sexp->string
180 ((@@ (guix scripts publish) signed-string)
182 (format #f "~aSignature: 1;~a;~a~%"
183 unsigned-info (gethostname) signature))
185 (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
189 (string-append "/" (store-path-hash-part item) ".narinfo"))))))
193 (call-with-temporary-output-file
195 (let ((nar (utf8->string
198 (string-append "/nar/" (basename %item)))))))
199 (call-with-input-string nar (cut restore-file <> temp)))
200 (call-with-input-file temp read-string))))
202 (unless (zlib-available?)
204 (test-equal "/nar/gzip/*"
206 (call-with-temporary-output-file
208 (let ((nar (http-get-port
210 (string-append "/nar/gzip/" (basename %item))))))
211 (call-with-gzip-input-port nar
212 (cut restore-file <> temp)))
213 (call-with-input-file temp read-string))))
215 (unless (zlib-available?)
217 (test-equal "/*.narinfo with compression"
218 `(("StorePath" . ,%item)
219 ("URL" . ,(string-append "nar/gzip/" (basename %item)))
220 ("Compression" . "gzip"))
221 (let ((thread (with-separate-output-ports
222 (call-with-new-thread
224 (guix-publish "--port=6799" "-C5"))))))
225 (wait-until-ready 6799)
226 (let* ((url (string-append "http://localhost:6799/"
227 (store-path-hash-part %item) ".narinfo"))
228 (body (http-get-port url)))
229 (filter (lambda (item)
231 (("Compression" . _) #t)
232 (("StorePath" . _) #t)
235 (recutils->alist body)))))
237 (unless (zlib-available?)
239 (test-equal "/*.narinfo for a compressed file"
240 '("none" "nar") ;compression-less nar
241 ;; Assume 'guix publish -C' is already running on port 6799.
242 (let* ((item (add-text-to-store %store "fake.tar.gz"
243 "This is a fake compressed file."))
244 (url (string-append "http://localhost:6799/"
245 (store-path-hash-part item) ".narinfo"))
246 (body (http-get-port url))
247 (info (recutils->alist body)))
248 (list (assoc-ref info "Compression")
249 (dirname (assoc-ref info "URL")))))
251 (test-equal "custom nar path"
252 ;; Serve nars at /foo/bar/chbouib instead of /nar.
253 (list `(("StorePath" . ,%item)
254 ("URL" . ,(string-append "foo/bar/chbouib/" (basename %item)))
255 ("Compression" . "none"))
258 (let ((thread (with-separate-output-ports
259 (call-with-new-thread
261 (guix-publish "--port=6798" "-C0"
262 "--nar-path=///foo/bar//chbouib/"))))))
263 (wait-until-ready 6798)
264 (let* ((base "http://localhost:6798/")
265 (part (store-path-hash-part %item))
266 (url (string-append base part ".narinfo"))
267 (nar-url (string-append base "foo/bar/chbouib/"
269 (body (http-get-port url)))
270 (list (filter (lambda (item)
272 (("Compression" . _) #t)
273 (("StorePath" . _) #t)
276 (recutils->alist body))
277 (response-code (http-get nar-url))
279 (http-get (string-append base "nar/" (basename %item))))))))
281 (test-equal "/nar/ with properly encoded '+' sign"
283 (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
284 (call-with-temporary-output-file
286 (let ((nar (utf8->string
289 (string-append "/nar/" (uri-encode (basename item))))))))
290 (call-with-input-string nar (cut restore-file <> temp)))
291 (call-with-input-file temp read-string)))))
293 (test-equal "/nar/invalid"
296 (call-with-output-file (string-append (%store-prefix) "/invalid")
298 (display "This file is not a valid store item." port)))
299 (response-code (http-get (publish-uri (string-append "/nar/invalid"))))))
301 (test-equal "/file/NAME/sha256/HASH"
303 (let* ((data "Hello, Guix world!")
304 (hash (call-with-input-string data port-sha256))
305 (drv (run-with-store %store
306 (gexp->derivation "the-file.txt"
307 #~(call-with-output-file #$output
309 (display #$data port)))
312 (out (build-derivations %store (list drv))))
316 (string-append "/file/the-file.txt/sha256/"
317 (bytevector->nix-base32-string hash)))))))
319 (test-equal "/file/NAME/sha256/INVALID-NIX-BASE32-STRING"
321 (let ((uri (publish-uri
322 "/file/the-file.txt/sha256/not-a-nix-base32-string")))
323 (response-code (http-get uri))))
325 (test-equal "/file/NAME/sha256/INVALID-HASH"
327 (let ((uri (publish-uri
328 (string-append "/file/the-file.txt/sha256/"
329 (bytevector->nix-base32-string
330 (call-with-input-string "" port-sha256))))))
331 (response-code (http-get uri))))
333 (unless (zlib-available?)
335 (test-equal "with cache"
337 `(("StorePath" . ,%item)
338 ("URL" . ,(string-append "nar/gzip/" (basename %item)))
339 ("Compression" . "gzip"))
344 (call-with-temporary-directory
346 (let ((thread (with-separate-output-ports
347 (call-with-new-thread
349 (guix-publish "--port=6797" "-C2"
350 (string-append "--cache=" cache)))))))
351 (wait-until-ready 6797)
352 (let* ((base "http://localhost:6797/")
353 (part (store-path-hash-part %item))
354 (url (string-append base part ".narinfo"))
355 (nar-url (string-append base "/nar/gzip/" (basename %item)))
356 (cached (string-append cache "/gzip/" (basename %item)
358 (nar (string-append cache "/gzip/"
359 (basename %item) ".nar"))
360 (response (http-get url)))
361 (and (= 404 (response-code response))
363 ;; We should get an explicitly short TTL for 404 in this case
364 ;; because it's going to become 200 shortly.
365 (match (assq-ref (response-headers response) 'cache-control)
369 (wait-for-file cached)
370 (let* ((body (http-get-port url))
371 (compressed (http-get nar-url))
372 (uncompressed (http-get (string-append base "nar/"
374 (narinfo (recutils->alist body)))
375 (list (file-exists? nar)
376 (filter (lambda (item)
378 (("Compression" . _) #t)
379 (("StorePath" . _) #t)
383 (response-code compressed)
384 (= (response-content-length compressed)
385 (stat:size (stat nar)))
387 (assoc-ref narinfo "FileSize"))
388 (stat:size (stat nar)))
389 (response-code uncompressed)))))))))
391 (unless (zlib-available?)
393 (let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
395 (test-equal "with cache, uncompressed"
397 `(("StorePath" . ,item)
398 ("URL" . ,(string-append "nar/" (basename item)))
399 ("Compression" . "none"))
402 (query-path-info %store item)) ;FileSize
404 (call-with-temporary-directory
406 (let ((thread (with-separate-output-ports
407 (call-with-new-thread
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))
422 (wait-for-file cached)
423 (let* ((body (http-get-port url))
424 (compressed (http-get (string-append base "nar/gzip/"
426 (uncompressed (http-get (string-append base "nar/"
428 (narinfo (recutils->alist body)))
429 (list (file-exists? nar)
430 (filter (lambda (item)
432 (("Compression" . _) #t)
433 (("StorePath" . _) #t)
437 (response-code uncompressed)
439 (assoc-ref narinfo "FileSize"))
440 (response-code compressed))))))))))