publish: Make the nar URL prefix a parameter.

* guix/scripts/publish.scm (narinfo-string): Add #:nar-path and honor it.
(render-narinfo): Likewise.
(make-request-handler): Likewise.
(run-publish-server): Likewise.
* tests/publish.scm ("custom nar path"): New test.
This commit is contained in:
Ludovic Courtès 2017-03-22 13:31:54 +01:00
parent 46f58390cb
commit cdd7a7d210
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 64 additions and 20 deletions

View file

@ -204,16 +204,17 @@ (define base64-encode-string
(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 @@ (define (render-nix-cache-info)
%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 @@ (define* (render-narinfo store request hash
'()))
(cut display
(narinfo-string store store-path (%private-key)
#:nar-path nar-path
#:compression compression)
<>)))))
@ -478,7 +481,12 @@ (define-server-impl concurrent-http-server
(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 @@ (define* (make-request-handler store
;; 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 @@ (define* (make-request-handler store
%default-gzip-compression)))
(not-found request)))
;; /nar/file/NAME/sha256/HASH
(("file" name "sha256" hash)
(guard (c ((invalid-base32-character? c)
;; /nar/<store-item>
((components ... store-item)
(if (nar-path? components)
(render-nar store request store-item
#:compression %no-compression)
(not-found request)))
(let ((hash (nix-base32-string->bytevector hash)))
(render-content-addressed-file store request
name 'sha256 hash))))
(_ (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

View file

@ -232,6 +232,36 @@ (define (wait-until-ready port)
(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!")))