publish: Encore URIs that appear in narinfos.
Fixes <http://bugs.gnu.org/21888>. Reported by iyzsong@member.fsf.org (宋文武). * guix/scripts/publish.scm (narinfo-string): Use 'encode-and-join-uri-path' instead of 'string-append' to compute URL. * tests/publish.scm ("/*.narinfo with properly encoded '+' sign"): ("/nar/ with properly encoded '+' sign"): New tests.
This commit is contained in:
parent
dc794a7238
commit
93961f0298
|
@ -146,7 +146,8 @@ Publish ~a over HTTP.\n") %store-directory)
|
||||||
"Generate a narinfo key/value string for STORE-PATH; an exception is raised
|
"Generate a narinfo key/value string for STORE-PATH; an exception is raised
|
||||||
if STORE-PATH is invalid. The narinfo is signed with KEY."
|
if STORE-PATH is invalid. The narinfo is signed with KEY."
|
||||||
(let* ((path-info (query-path-info store store-path))
|
(let* ((path-info (query-path-info store store-path))
|
||||||
(url (string-append "nar/" (basename store-path)))
|
(url (encode-and-join-uri-path (list "nar"
|
||||||
|
(basename store-path))))
|
||||||
(hash (bytevector->nix-base32-string
|
(hash (bytevector->nix-base32-string
|
||||||
(path-info-hash path-info)))
|
(path-info-hash path-info)))
|
||||||
(size (path-info-nar-size path-info))
|
(size (path-info-nar-size path-info))
|
||||||
|
|
|
@ -30,12 +30,14 @@
|
||||||
#:use-module (guix base64)
|
#:use-module (guix base64)
|
||||||
#:use-module ((guix serialization) #:select (restore-file))
|
#:use-module ((guix serialization) #:select (restore-file))
|
||||||
#:use-module (guix pk-crypto)
|
#:use-module (guix pk-crypto)
|
||||||
|
#:use-module (web uri)
|
||||||
#:use-module (web client)
|
#:use-module (web client)
|
||||||
#:use-module (web response)
|
#:use-module (web response)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
|
#:use-module (ice-9 format)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 rdelim))
|
#:use-module (ice-9 rdelim))
|
||||||
|
|
||||||
|
@ -101,6 +103,37 @@ References: ~a~%"
|
||||||
(publish-uri
|
(publish-uri
|
||||||
(string-append "/" (store-path-hash-part %item) ".narinfo")))))
|
(string-append "/" (store-path-hash-part %item) ".narinfo")))))
|
||||||
|
|
||||||
|
(test-equal "/*.narinfo with properly encoded '+' sign"
|
||||||
|
;; See <http://bugs.gnu.org/21888>.
|
||||||
|
(let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
|
||||||
|
(info (query-path-info %store item))
|
||||||
|
(unsigned-info
|
||||||
|
(format #f
|
||||||
|
"StorePath: ~a
|
||||||
|
URL: nar/~a
|
||||||
|
Compression: none
|
||||||
|
NarHash: sha256:~a
|
||||||
|
NarSize: ~d
|
||||||
|
References: ~%"
|
||||||
|
item
|
||||||
|
(uri-encode (basename item))
|
||||||
|
(bytevector->nix-base32-string
|
||||||
|
(path-info-hash info))
|
||||||
|
(path-info-nar-size info)))
|
||||||
|
(signature (base64-encode
|
||||||
|
(string->utf8
|
||||||
|
(canonical-sexp->string
|
||||||
|
((@@ (guix scripts publish) signed-string)
|
||||||
|
unsigned-info))))))
|
||||||
|
(format #f "~aSignature: 1;~a;~a~%"
|
||||||
|
unsigned-info (gethostname) signature))
|
||||||
|
|
||||||
|
(let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
|
||||||
|
(utf8->string
|
||||||
|
(http-get-body
|
||||||
|
(publish-uri
|
||||||
|
(string-append "/" (store-path-hash-part item) ".narinfo"))))))
|
||||||
|
|
||||||
(test-equal "/nar/*"
|
(test-equal "/nar/*"
|
||||||
"bar"
|
"bar"
|
||||||
(call-with-temporary-output-file
|
(call-with-temporary-output-file
|
||||||
|
@ -112,6 +145,18 @@ References: ~a~%"
|
||||||
(call-with-input-string nar (cut restore-file <> temp)))
|
(call-with-input-string nar (cut restore-file <> temp)))
|
||||||
(call-with-input-file temp read-string))))
|
(call-with-input-file temp read-string))))
|
||||||
|
|
||||||
|
(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"
|
(test-equal "/nar/invalid"
|
||||||
404
|
404
|
||||||
(begin
|
(begin
|
||||||
|
|
Loading…
Reference in New Issue