store: 'store-path-hash-part' really returns false for invalid file names. - guix

diff options

author	Ludovic Courtès <ludo@gnu.org>	2021-02-03 14:43:29 +0100
committer	Ludovic Courtès <ludo@gnu.org>	2021-02-04 09:23:38 +0100
commit	814ee99da89a0bcc6cf53d61763d345ed95e067c (patch)
tree	f7f9d406b1fe90c758f4429c3d92078b9c88c464 /tests/cve.scm
parent	8e7e414aa998fe8c0de8a491c91aab8b8d9c58f4 (diff)
download	guix-814ee99da89a0bcc6cf53d61763d345ed95e067c.tar.gz guix-814ee99da89a0bcc6cf53d61763d345ed95e067c.zip

store: 'store-path-hash-part' really returns false for invalid file names.

The "store-path-hash-part #f", due to a SRFI-64 bug, was marked as successful even though 'store-path-hash-part' was throwing an exception. * guix/store.scm (store-path-hash-part): Really return #f.

Diffstat (limited to 'tests/cve.scm')

0 files changed, 0 insertions, 0 deletions

(call-with-values (lambda () (package-specification->name+version+output spec)) list)) '("guile" "guile@2.0.9" "guile:debug" "guile@2.0.9:debug" "guile-cairo@1.4.1"))) (test-equal "integer" '(1) (string->generations "1")) (test-equal "comma-separated integers" '(3 7 1 4 6) (string->generations "3,7,1,4,6")) (test-equal "closed range" '(4 5 6 7 8 9 10 11 12) (string->generations "4..12")) (test-equal "closed range, equal endpoints" '(3) (string->generations "3..3")) (test-equal "indefinite end range" '(>= 7) (string->generations "7..")) (test-equal "indefinite start range" '(<= 42) (string->generations "..42")) (test-equal "integer, char" #f (string->generations "a")) (test-equal "comma-separated integers, consecutive comma" #f (string->generations "1,,2")) (test-equal "comma-separated integers, trailing comma" #f (string->generations "1,2,")) (test-equal "comma-separated integers, chars" #f (string->generations "a,b")) (test-equal "closed range, start > end" #f (string->generations "9..2")) (test-equal "closed range, chars" #f (string->generations "a..b")) (test-equal "indefinite end range, char" #f (string->generations "a..")) (test-equal "indefinite start range, char" #f (string->generations "..a")) (test-equal "duration, 1 day" (make-time time-duration 0 (* 3600 24)) (string->duration "1d")) (test-equal "duration, 1 week" (make-time time-duration 0 (* 3600 24 7)) (string->duration "1w")) (test-equal "duration, 1 month" (make-time time-duration 0 (* 3600 24 30)) (string->duration "1m")) (test-equal "duration, 1 week == 7 days" (string->duration "1w") (string->duration "7d")) (test-equal "duration, 1 month == 30 days" (string->duration "1m") (string->duration "30d")) (test-equal "duration, 2 hours" 7200 (time-second (string->duration "2h"))) (test-equal "duration, 1 second" (make-time time-duration 0 1) (string->duration "1s")) (test-equal "duration, integer" #f (string->duration "1")) (test-equal "duration, char" #f (string->duration "d")) (test-equal "size->number, bytes" 42 (size->number "42")) (test-equal "size->number, MiB" (* 42 (expt 2 20)) (size->number "42MiB")) (test-equal "size->number, GiB" (* 3 (expt 2 30)) (size->number "3GiB")) (test-equal "size->number, 1.2GiB" (inexact->exact (round (* 1.2 (expt 2 30)))) (size->number "1.2GiB")) (test-equal "size->number, 1T" (expt 2 40) (size->number "1T")) (test-equal "size->number, 1.M" (expt 2 20) (size->number "1.M")) (test-assert "size->number, invalid unit" (catch 'quit (lambda () (size->number "9X")) (lambda args #t))) (test-equal "show-what-to-build, zero outputs" "" (with-store store (let ((drv (derivation store "zero" "/bin/sh" '() #:outputs '()))) (with-error-to-string (lambda () ;; This should print nothing. (show-what-to-build store (list drv))))))) (test-assert "show-manifest-transaction" (let* ((m (manifest (list guile-1.8.8))) (t (manifest-transaction (install (list guile-2.0.9))))) (with-store store (and (string-match "guile +1.8.8 → 2.0.9" (with-fluids ((%default-port-encoding "UTF-8")) (with-error-to-string (lambda () (show-manifest-transaction store m t))))) (string-match "guile +1.8.8 -> 2.0.9" (with-error-to-string (lambda () ;; In Guile 2.2, %DEFAULT-PORT-ENCODING doesn't ;; influence the encoding of string ports. (set-port-encoding! (current-error-port) "ISO-8859-1") (show-manifest-transaction store m t)))))))) (test-assert "package-relevance" (let ((guile (specification->package "guile")) (gcrypt (specification->package "guile-gcrypt")) (go (specification->package "go")) (gnugo (specification->package "gnugo")) (libb2 (specification->package "libb2")) (rx (cut make-regexp <> regexp/icase)) (>0 (cut > <> 0)) (=0 zero?)) (and (>0 (package-relevance guile (map rx '("scheme")))) (>0 (package-relevance guile (map rx '("scheme" "implementation")))) (>0 (package-relevance gcrypt (map rx '("guile" "crypto")))) (=0 (package-relevance guile (map rx '("guile" "crypto")))) (>0 (package-relevance go (map rx '("go")))) (=0 (package-relevance go (map rx '("go" "game")))) (>0 (package-relevance gnugo (map rx '("go" "game")))) (>0 (package-relevance libb2 (map rx '("crypto" "library"))))))) (test-assert "package-relevance and upstream name" ;; https://issues.guix.gnu.org/58136 (let ((ggplot2 (specification->package "r-ggplot2")) (ggstance (specification->package "r-ggstance")) (rx (make-regexp "ggplot2" regexp/icase))) (> (package-relevance ggplot2 (list rx)) (package-relevance ggstance (list rx)) 0))) (define (make-empty-file directory file) ;; Create FILE in DIRECTORY. (close-port (open-output-file (in-vicinity directory file)))) (define (assert-equals-find-available-pager expected) ;; Use 'with-paginated-output-port' and return true if it invoked EXPECTED. (define used-command "") (mock ((ice-9 popen) open-pipe* (lambda (mode command . args) (unless (string-null? used-command) (error "open-pipe* should only be called once")) (set! used-command command) (%make-void-port ""))) (mock ((ice-9 popen) close-pipe (const 'ok)) (mock ((guix colors) isatty?* (const #t)) (with-paginated-output-port port 'ok) (string=? expected used-command))))) (test-assert "find-available-pager, GUIX_PAGER takes precedence" (call-with-temporary-directory (lambda (dir) (with-environment-variables `(("PATH" ,dir) ("GUIX_PAGER" "guix-pager") ("PAGER" "pager")) (make-empty-file dir "less") (make-empty-file dir "more") (assert-equals-find-available-pager "guix-pager"))))) (test-assert "find-available-pager, PAGER takes precedence" (call-with-temporary-directory (lambda (dir) (with-environment-variables `(("PATH" ,dir) ("GUIX_PAGER" #false) ("PAGER" "pager")) (make-empty-file dir "less") (make-empty-file dir "more") (assert-equals-find-available-pager "pager"))))) (test-assert "find-available-pager, 'less' takes precedence" (call-with-temporary-directory (lambda (dir) (with-environment-variables `(("PATH" ,dir) ("GUIX_PAGER" #false) ("PAGER" #false)) (make-empty-file dir "less") (make-empty-file dir "more") (assert-equals-find-available-pager (in-vicinity dir "less")))))) (test-assert "find-available-pager, 'more' takes precedence" (call-with-temporary-directory (lambda (dir) (with-environment-variables `(("PATH" ,dir) ("GUIX_PAGER" #false) ("PAGER" #false)) (make-empty-file dir "more") (assert-equals-find-available-pager (in-vicinity dir "more")))))) (test-assert "find-available-pager, no pager" (call-with-temporary-directory (lambda (dir) (with-environment-variables `(("PATH" ,dir) ("GUIX_PAGER" #false) ("PAGER" #false)) (assert-equals-find-available-pager ""))))) (test-end "ui")


context:
space:
mode: