~ruther/guix-local

93961f02987cf738d116cc85cc32d97c2a488222 — Ludovic Courtès 9 years ago dc794a7
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.
2 files changed, 47 insertions(+), 1 deletions(-)

M guix/scripts/publish.scm
M tests/publish.scm
M guix/scripts/publish.scm => guix/scripts/publish.scm +2 -1
@@ 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))

M tests/publish.scm => tests/publish.scm +45 -0
@@ 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