;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson ;;; Copyright © 2020 by Amar M. Singh ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . ;; Avoid interference. (unsetenv "http_proxy") (define

path: root/gnu

Mode	Name	Size
-rw-r--r--	artwork.scm	1605	log plain about
-rw-r--r--	bootloader.scm	18535	log plain about
d---------	bootloader	157	log plain
d---------	build	897	log plain
-rw-r--r--	ci.scm	23620	log plain about
-rw-r--r--	compression.scm	2898	log plain about
-rw-r--r--	home.scm	5999	log plain about
d---------	home	75	log plain
-rw-r--r--	image.scm	8583	log plain about
-rw-r--r--	installer.scm	27438	log plain about
d---------	installer	792	log plain
-rw-r--r--	local.mk	116405	log plain about
-rw-r--r--	machine.scm	4858	log plain about
d---------	machine	80	log plain
-rw-r--r--	packages.scm	25250	log plain about
d---------	packages	22964	log plain
-rw-r--r--	services.scm	53586	log plain about
d---------	services	2294	log plain
-rw-r--r--	system.scm	70133	log plain about
d---------	system	736	log plain
-rw-r--r--	tests.scm	12278	log plain about
d---------	tests	1633	log plain

(response-code (http-get nar-url)) (response-code (http-get (string-append base "nar/" (basename %item)))))))) (test-equal "/nar/ with properly encoded '+' sign" "Congrats!" (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))) (call-with-temporary-output-file (lambda (temp port) (let ((nar (utf8->string (http-get-body (publish-uri (string-append "/nar/" (uri-encode (basename item)))))))) (call-with-input-string nar (cut restore-file <> temp))) (call-with-input-file temp read-string))))) (test-equal "/nar/invalid" 404 (begin (call-with-output-file (string-append (%store-prefix) "/invalid") (lambda (port) (display "This file is not a valid store item." port))) (response-code (http-get (publish-uri (string-append "/nar/invalid")))))) (test-equal "/file/NAME/sha256/HASH" "Hello, Guix world!" (let* ((data "Hello, Guix world!") (hash (call-with-input-string data port-sha256)) (drv (run-with-store %store (gexp->derivation "the-file.txt" #~(call-with-output-file #$output (lambda (port) (display #$data port))) #:hash-algo 'sha256 #:hash hash))) (out (build-derivations %store (list drv)))) (utf8->string (http-get-body (publish-uri (string-append "/file/the-file.txt/sha256/" (bytevector->nix-base32-string hash))))))) (test-equal "/file/NAME/sha256/INVALID-NIX-BASE32-STRING" 404 (let ((uri (publish-uri "/file/the-file.txt/sha256/not-a-nix-base32-string"))) (response-code (http-get uri)))) (test-equal "/file/NAME/sha256/INVALID-HASH" 404 (let ((uri (publish-uri (string-append "/file/the-file.txt/sha256/" (bytevector->nix-base32-string (call-with-input-string "" port-sha256)))))) (response-code (http-get uri)))) (test-equal "with cache" (list #t `(("StorePath" . ,%item) ("URL" . ,(string-append "nar/gzip/" (basename %item))) ("Compression" . "gzip")) 200 ;nar/gzip/… #t ;Content-Length #t ;FileSize 404) ;nar/… (call-with-temporary-directory (lambda (cache) (let ((thread (with-separate-output-ports (call-with-new-thread (lambda () (guix-publish "--port=6797" "-C2" (string-append "--cache=" cache) "--cache-bypass-threshold=0")))))) (wait-until-ready 6797) (let* ((base "http://localhost:6797/") (part (store-path-hash-part %item)) (url (string-append base part ".narinfo")) (nar-url (string-append base "nar/gzip/" (basename %item))) (cached (string-append cache "/gzip/" (basename %item) ".narinfo")) (nar (string-append cache "/gzip/" (basename %item) ".nar")) (response (http-get url))) (and (= 404 (response-code response)) ;; We should get an explicitly short TTL for 404 in this case ;; because it's going to become 200 shortly. (match (assq-ref (response-headers response) 'cache-control) ((('max-age . ttl)) (< ttl 3600))) (wait-for-file cached) ;; Both the narinfo and nar should be world-readable. (= #o444 (logand #o444 (stat:perms (lstat cached)))) (= #o444 (logand #o444 (stat:perms (lstat nar)))) (let* ((body (http-get-port url)) (compressed (http-get nar-url)) (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 compressed) (= (response-content-length compressed) (stat:size (stat nar))) (= (string->number (assoc-ref narinfo "FileSize")) (stat:size (stat nar))) (response-code uncompressed))))))))) (test-equal "with cache, lzip + gzip" '(200 200 404) (call-with-temporary-directory (lambda (cache) (let ((thread (with-separate-output-ports (call-with-new-thread (lambda () (guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2" (string-append "--cache=" cache) "--cache-bypass-threshold=0")))))) (wait-until-ready 6794) (let* ((base "http://localhost:6794/") (part (store-path-hash-part %item)) (url (string-append base part ".narinfo")) (nar-url (cute string-append "nar/" <> "/" (basename %item))) (cached (cute string-append cache "/" <> "/" (basename %item) ".narinfo")) (nar (cute string-append cache "/" <> "/" (basename %item) ".nar")) (response (http-get url))) (wait-for-file (cached "gzip")) (let* ((body (http-get-port url)) (narinfo (recutils->alist body)) (uncompressed (string-append base "nar/" (basename %item)))) (and (file-exists? (nar "gzip")) (file-exists? (nar "lzip")) (equal? (take (pk 'narinfo/gzip+lzip narinfo) 7) `(("StorePath" . ,%item) ("URL" . ,(nar-url "gzip")) ("Compression" . "gzip") ("FileSize" . ,(number->string (stat:size (stat (nar "gzip"))))) ("URL" . ,(nar-url "lzip")) ("Compression" . "lzip") ("FileSize" . ,(number->string (stat:size (stat (nar "lzip"))))))) (list (response-code (http-get (string-append base (nar-url "gzip")))) (response-code (http-get (string-append base (nar-url "lzip")))) (response-code (http-get uncompressed)))))))))) (let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz" (random-text)))) (test-equal "with cache, uncompressed" (list #t (* 42 3600) ;TTL on narinfo `(("StorePath" . ,item) ("URL" . ,(string-append "nar/" (basename item))) ("Compression" . "none")) 200 ;nar/… (* 42 3600) ;TTL on 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" "--ttl=42h" (string-append "--cache=" cache) "--cache-bypass-threshold=0")))))) (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* ((response (http-get url)) (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) (match (assq-ref (response-headers response) 'cache-control) ((('max-age . ttl)) ttl) (_ #f)) (filter (lambda (item) (match item (("Compression" . _) #t) (("StorePath" . _) #t) (("URL" . _) #t) (_ #f))) narinfo) (response-code uncompressed) (match (assq-ref (response-headers uncompressed) 'cache-control) ((('max-age . ttl)) ttl) (_ #f)) (string->number (assoc-ref narinfo "FileSize")) (response-code compressed)))))))))) (test-equal "with cache, vanishing item" ; 200 (call-with-temporary-directory (lambda (cache) (let ((thread (with-separate-output-ports (call-with-new-thread (lambda () (guix-publish "--port=6795" (string-append "--cache=" cache))))))) (wait-until-ready 6795) ;; Make sure that, even if ITEM disappears, we're still able to fetch ;; it. (let* ((base "http://localhost:6795/") (item (add-text-to-store %store "random" (random-text))) (part (store-path-hash-part item)) (url (string-append base part ".narinfo")) (cached (string-append cache "/gzip/" (basename item) ".narinfo")) (response (http-get url))) (and (= 200 (response-code response)) ;we're below the threshold (wait-for-file cached) (begin (delete-paths %store (list item)) (response-code (pk 'response (http-get url)))))))))) (test-equal "with cache, cache bypass" 200 (call-with-temporary-directory (lambda (cache) (let ((thread (with-separate-output-ports (call-with-new-thread (lambda () (guix-publish "--port=6788" "-C" "gzip" (string-append "--cache=" cache))))))) (wait-until-ready 6788) (let* ((base "http://localhost:6788/") (item (add-text-to-store %store "random" (random-text))) (part (store-path-hash-part item)) (narinfo (string-append base part ".narinfo")) (nar (string-append base "nar/gzip/" (basename item))) (cached (string-append cache "/gzip/" (basename item) ".narinfo"))) ;; We're below the default cache bypass threshold, so NAR and NARINFO ;; should immediately return 200. The NARINFO request should trigger ;; caching, and the next request to NAR should return 200 as well. (and (let ((response (pk 'r1 (http-get nar)))) (and (= 200 (response-code response)) (not (response-content-length response)))) ;not known (= 200 (response-code (http-get narinfo))) (begin (wait-for-file cached) (let ((response (pk 'r2 (http-get nar)))) (and (> (response-content-length response) (stat:size (stat item))) (response-code response)))))))))) (test-equal "with cache, cache bypass, unmapped hash part" 200 ;; This test reproduces the bug described in : ;; the daemon connection would be closed as a side effect of a nar request ;; for a non-existing file name. (call-with-temporary-directory (lambda (cache) (let ((thread (with-separate-output-ports (call-with-new-thread (lambda () (guix-publish "--port=6787" "-C" "gzip" (string-append "--cache=" cache))))))) (wait-until-ready 6787) (let* ((base "http://localhost:6787/") (item (add-text-to-store %store "random" (random-text))) (part (store-path-hash-part item)) (narinfo (string-append base part ".narinfo")) (nar (string-append base "nar/gzip/" (basename item))) (cached (string-append cache "/gzip/" (basename item) ".narinfo"))) ;; The first response used to be 500 and to terminate the daemon ;; connection as a side effect. (and (= (response-code (http-get (string-append base "nar/gzip/" (make-string 32 #\e) "-does-not-exist"))) 404) (= 200 (response-code (http-get nar))) (= 200 (response-code (http-get narinfo))) (begin (wait-for-file cached) (response-code (http-get nar))))))))) (test-equal "/log/NAME" `(200 #t application/x-bzip2) (let ((drv (run-with-store %store (gexp->derivation "with-log" #~(call-with-output-file #$output (lambda (port) (display "Hello, build log!" (current-error-port)) (display #$(random-text) port))))))) (build-derivations %store (list drv)) (let* ((response (http-get (publish-uri (string-append "/log/" (basename (derivation->output-path drv)))) #:decode-body? #f)) (base (basename (derivation-file-name drv))) (log (string-append (dirname %state-directory) "/log/guix/drvs/" (string-take base 2) "/" (string-drop base 2) ".bz2"))) (list (response-code response) (= (response-content-length response) (stat:size (stat log))) (first (response-content-type response)))))) (test-equal "negative TTL" `(404 42) (call-with-temporary-directory (lambda (cache) (let ((thread (with-separate-output-ports (call-with-new-thread (lambda () (guix-publish "--port=6786" "-C0" "--negative-ttl=42s")))))) (wait-until-ready 6786) (let* ((base "http://localhost:6786/") (url (string-append base (make-string 32 #\z) ".narinfo")) (response (http-get url))) (list (response-code response) (match (assq-ref (response-headers response) 'cache-control) ((('max-age . ttl)) ttl) (_ #f)))))))) (test-equal "no negative TTL" `(404 #f) (let* ((uri (publish-uri (string-append "/" (make-string 32 #\z) ".narinfo"))) (response (http-get uri))) (list (response-code response) (assq-ref (response-headers response) 'cache-control)))) (test-equal "/log/NAME not found" 404 (let ((uri (publish-uri "/log/does-not-exist"))) (response-code (http-get uri)))) (test-equal "/signing-key.pub" 200 (response-code (http-get (publish-uri "/signing-key.pub")))) (test-equal "non-GET query" '(200 404) (let ((path (string-append "/" (store-path-hash-part %item) ".narinfo"))) (map response-code (list (http-get (publish-uri path)) (http-post (publish-uri path)))))) (test-end "publish")