diff options
| -rw-r--r-- | guix/scripts/publish.scm | 54 | ||||
| -rw-r--r-- | tests/publish.scm | 30 |
2 files changed, 64 insertions, 20 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 5a5ef68422..ba5be04818 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -204,16 +204,17 @@ compression disabled~%")) (compose base64-encode string->utf8)) (define* (narinfo-string store store-path key - #:key (compression %no-compression)) + #:key (compression %no-compression) + (nar-path "nar")) "Generate a narinfo key/value string for STORE-PATH; an exception is raised if STORE-PATH is invalid. Produce a URL that corresponds to COMPRESSION. The -narinfo is signed with KEY." +narinfo is signed with KEY. NAR-PATH specifies the prefix for nar URLs." (let* ((path-info (query-path-info store store-path)) (compression (if (compressed-file? store-path) %no-compression compression)) (url (encode-and-join-uri-path - `("nar" + `(,@(split-and-decode-uri-path nar-path) ,@(match compression (($ <compression> 'none) '()) @@ -275,11 +276,12 @@ References: ~a~%" %nix-cache-info)))) (define* (render-narinfo store request hash - #:key ttl (compression %no-compression)) + #:key ttl (compression %no-compression) + (nar-path "nar")) "Render metadata for the store path corresponding to HASH. If TTL is true, advertise it as the maximum validity period (in seconds) via the 'Cache-Control' header. This allows 'guix substitute' to cache it for an -appropriate duration." +appropriate duration. NAR-PATH specifies the prefix for nar URLs." (let ((store-path (hash-part->path store hash))) (if (string-null? store-path) (not-found request) @@ -289,6 +291,7 @@ appropriate duration." '())) (cut display (narinfo-string store store-path (%private-key) + #:nar-path nar-path #:compression compression) <>))))) @@ -478,7 +481,12 @@ blocking." (define* (make-request-handler store #:key narinfo-ttl + (nar-path "nar") (compression %no-compression)) + (define nar-path? + (let ((expected (split-and-decode-uri-path nar-path))) + (cut equal? expected <>))) + (lambda (request body) (format #t "~a ~a~%" (request-method request) @@ -494,19 +502,23 @@ blocking." ;; NARINFO-TTL. (render-narinfo store request hash #:ttl narinfo-ttl + #:nar-path nar-path #:compression compression)) + ;; /nar/file/NAME/sha256/HASH + (("file" name "sha256" hash) + (guard (c ((invalid-base32-character? c) + (not-found request))) + (let ((hash (nix-base32-string->bytevector hash))) + (render-content-addressed-file store request + name 'sha256 hash)))) ;; Use different URLs depending on the compression type. This ;; guarantees that /nar URLs remain valid even when 'guix publish' ;; is restarted with different compression parameters. - ;; /nar/<store-item> - (("nar" store-item) - (render-nar store request store-item - #:compression %no-compression)) ;; /nar/gzip/<store-item> - (("nar" "gzip" store-item) - (if (zlib-available?) + ((components ... "gzip" store-item) + (if (and (nar-path? components) (zlib-available?)) (render-nar store request store-item #:compression (match compression @@ -516,19 +528,21 @@ blocking." %default-gzip-compression))) (not-found request))) - ;; /nar/file/NAME/sha256/HASH - (("file" name "sha256" hash) - (guard (c ((invalid-base32-character? c) - (not-found request))) - (let ((hash (nix-base32-string->bytevector hash))) - (render-content-addressed-file store request - name 'sha256 hash)))) - (_ (not-found request))) + ;; /nar/<store-item> + ((components ... store-item) + (if (nar-path? components) + (render-nar store request store-item + #:compression %no-compression) + (not-found request))) + + (x (not-found request))) (not-found request)))) (define* (run-publish-server socket store - #:key (compression %no-compression) narinfo-ttl) + #:key (compression %no-compression) + (nar-path "nar") narinfo-ttl) (run-server (make-request-handler store + #:nar-path nar-path #:narinfo-ttl narinfo-ttl #:compression compression) concurrent-http-server diff --git a/tests/publish.scm b/tests/publish.scm index c0a0f72d9b..ea0f4a3477 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -232,6 +232,36 @@ References: ~%" (list (assoc-ref info "Compression") (dirname (assoc-ref info "URL"))))) +(test-equal "custom nar path" + ;; Serve nars at /foo/bar/chbouib instead of /nar. + (list `(("StorePath" . ,%item) + ("URL" . ,(string-append "foo/bar/chbouib/" (basename %item))) + ("Compression" . "none")) + 200 + 404) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6798" "-C0" + "--nar-path=///foo/bar//chbouib/")))))) + (wait-until-ready 6798) + (let* ((base "http://localhost:6798/") + (part (store-path-hash-part %item)) + (url (string-append base part ".narinfo")) + (nar-url (string-append base "foo/bar/chbouib/" + (basename %item))) + (body (http-get-port url))) + (list (filter (lambda (item) + (match item + (("Compression" . _) #t) + (("StorePath" . _) #t) + (("URL" . _) #t) + (_ #f))) + (recutils->alist body)) + (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!"))) |