03/03: publish: Encore URIs that appear in narinfos.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 93961f02987cf738d116cc85cc32d97c2a488222
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jun 8 18:59:25 2016 +0200

    publish: Encore URIs that appear in narinfos.
    
    Fixes <http://bugs.gnu.org/21888>.
    Reported by address@hidden (宋文武).
    
    * 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.
---
 guix/scripts/publish.scm |    3 ++-
 tests/publish.scm        |   45 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 47 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 4629213..ddb579b 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -146,7 +146,8 @@ Publish ~a over HTTP.\n") %store-directory)
   "Generate a narinfo key/value string for STORE-PATH; an exception is raised
 if STORE-PATH is invalid.  The narinfo is signed with KEY."
   (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
                       (path-info-hash path-info)))
          (size       (path-info-nar-size path-info))
diff --git a/tests/publish.scm b/tests/publish.scm
index 6645286..d6d537c 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -30,12 +30,14 @@
   #:use-module (guix base64)
   #:use-module ((guix serialization) #:select (restore-file))
   #:use-module (guix pk-crypto)
+  #:use-module (web uri)
   #:use-module (web client)
   #:use-module (web response)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim))
 
@@ -101,6 +103,37 @@ References: ~a~%"
     (publish-uri
      (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/*"
   "bar"
   (call-with-temporary-output-file
@@ -112,6 +145,18 @@ References: ~a~%"
        (call-with-input-string nar (cut restore-file <> temp)))
      (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"
   404
   (begin