Merge branch 'master' into core-updates

3 files changed, 91 insertions, 2 deletions

diff --git a/tests/nar.scm b/tests/nar.scm
index 9796980e35..4f4b304b1d 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -241,6 +241,46 @@
       (lambda ()
         (rmdir input)))))
 
+(test-assert "write-file #:select? + restore-file"
+  (let ((input (string-append %test-dir ".input")))
+    (mkdir input)
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (with-file-tree input
+            (directory "root"
+                       ((directory "a" (("x") ("y") ("z")))
+                        ("b") ("c") ("d" -> "b")))
+          (let* ((output %test-dir)
+                 (nar    (string-append output ".nar")))
+            (dynamic-wind
+              (lambda () #t)
+              (lambda ()
+                (call-with-output-file nar
+                  (lambda (port)
+                    (write-file input port
+                                #:select?
+                                (lambda (file stat)
+                                  (and (not (string=? (basename file)
+                                                      "a"))
+                                       (not (eq? (stat:type stat)
+                                                 'symlink)))))))
+                (call-with-input-file nar
+                  (cut restore-file <> output))
+
+                ;; Make sure "a" and "d" have been filtered out.
+                (and (not (file-exists? (string-append output "/root/a")))
+                     (file=? (string-append output "/root/b")
+                             (string-append input "/root/b"))
+                     (file=? (string-append output "/root/c")
+                             (string-append input "/root/c"))
+                     (not (file-exists? (string-append output "/root/d")))))
+              (lambda ()
+                (false-if-exception (delete-file nar))
+                (false-if-exception (rm-rf output)))))))
+      (lambda ()
+        (rmdir input)))))
+
 ;; 'restore-file-set' depends on 'open-sha256-input-port', which in turn
 ;; relies on a Guile 2.0.10+ feature.
 (test-skip (if (false-if-exception
diff --git a/tests/publish.scm b/tests/publish.scm
index 6645286f5a..d6d537c58a 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
diff --git a/tests/ui.scm b/tests/ui.scm
index 51577acb76..058207e8b9 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -189,6 +189,10 @@ Second line" 24))
   (string->duration "1m")
   (string->duration "30d"))
 
+(test-equal "duration, 1 second"
+  (make-time time-duration 0 1)
+  (string->duration "1s"))
+
 (test-equal "duration, integer"
   #f
   (string->duration "1"))