diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/guix-archive.sh | 66 | ||||
| -rw-r--r-- | tests/guix-authenticate.sh | 63 | ||||
| -rw-r--r-- | tests/guix-package.sh | 9 | ||||
| -rw-r--r-- | tests/pk-crypto.scm | 230 | ||||
| -rw-r--r-- | tests/pki.scm | 51 | ||||
| -rw-r--r-- | tests/signing-key.pub | 4 | ||||
| -rw-r--r-- | tests/signing-key.sec | 8 | ||||
| -rw-r--r-- | tests/store.scm | 45 |
8 files changed, 475 insertions, 1 deletions
diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh new file mode 100644 index 0000000000..0de7395145 --- /dev/null +++ b/tests/guix-archive.sh @@ -0,0 +1,66 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +# +# This file is part of GNU Guix. +# +# GNU Guix is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or (at +# your option) any later version. +# +# GNU Guix is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +# +# Test the 'guix archive' command-line utility. +# + +guix archive --version + +archive="t-archive-$$" +archive_alt="t-archive-alt-$$" +rm -f "$archive" "$archive_alt" + +trap 'rm -f "$archive" "$archive_alt"' EXIT + +guix archive --export guile-bootstrap > "$archive" +guix archive --export guile-bootstrap:out > "$archive_alt" +cmp "$archive" "$archive_alt" + +guix archive --export \ + -e '(@ (gnu packages bootstrap) %bootstrap-guile)' > "$archive_alt" +cmp "$archive" "$archive_alt" + +guix archive --export `guix build guile-bootstrap` > "$archive_alt" +cmp "$archive" "$archive_alt" + +guix archive --import < "$archive" 2>&1 | grep "import.*guile-bootstrap" + +if guix archive something-that-does-not-exist +then false; else true; fi + +# This one must not be listed as missing. +guix build guile-bootstrap > "$archive" +guix archive --missing < "$archive" +test "`guix archive --missing < "$archive"`" = "" + +# Two out of three should be listed as missing. +echo "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" >> "$archive" +echo "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bar" >> "$archive" +guix archive --missing < "$archive" > "$archive_alt" +echo "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" > "$archive" +echo "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bar" >> "$archive" +cmp "$archive" "$archive_alt" + +# This is not a valid store file name, so an error. +echo something invalid > "$archive" +if guix archive --missing < "$archive" +then false; else true; fi + +if echo foo | guix archive --authorize +then false; else true; fi diff --git a/tests/guix-authenticate.sh b/tests/guix-authenticate.sh new file mode 100644 index 0000000000..aa6f9e9f01 --- /dev/null +++ b/tests/guix-authenticate.sh @@ -0,0 +1,63 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +# +# This file is part of GNU Guix. +# +# GNU Guix is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or (at +# your option) any later version. +# +# GNU Guix is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +# +# Test the 'guix authenticate' command-line utility. +# + +guix authenticate --version + +sig="t-signature-$$" +hash="t-hash-$$" +rm -f "$sig" "$hash" + +trap 'rm -f "$sig" "$hash"' EXIT + +# A hexadecimal string as long as a sha256 hash. +echo "2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb" \ + > "$hash" + +guix authenticate rsautl -sign \ + -inkey "$abs_top_srcdir/tests/signing-key.sec" \ + -in "$hash" > "$sig" +test -f "$sig" + +hash2="`guix authenticate rsautl -verify \ + -inkey $abs_top_srcdir/tests/signing-key.pub \ + -pubin -in $sig`" +test "$hash2" = `cat "$hash"` + +# Detect corrupt signatures. +if guix authenticate rsautl -verify \ + -inkey "$abs_top_srcdir/tests/signing-key.pub" \ + -pubin -in /dev/null +then false +else true +fi + +# Detect invalid signatures. +# The signature has (payload (data ... (hash sha256 #...#))). We proceed by +# modifying this hash. +sed -i "$sig" \ + -e's|#[A-Z0-9]\{64\}#|#0000000000000000000000000000000000000000000000000000000000000000#|g' +if guix authenticate rsautl -verify \ + -inkey "$abs_top_srcdir/tests/signing-key.pub" \ + -pubin -in "$sig" +then false +else true +fi diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 47a2d06cb3..b79c4951d8 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> # # This file is part of GNU Guix. @@ -218,3 +218,10 @@ done # Extraneous argument. if guix package install foo-bar; then false; else true; fi + +# Make sure the "broken pipe" doesn't yield an error. +# Note: 'pipefail' is a Bash-specific option. +set -o pipefail || true +guix package -A g | head -1 2> "$HOME/err1" +guix package -I | head -1 2> "$HOME/err2" +test "`cat "$HOME/err1" "$HOME/err2"`" = "" diff --git a/tests/pk-crypto.scm b/tests/pk-crypto.scm new file mode 100644 index 0000000000..6774dd4157 --- /dev/null +++ b/tests/pk-crypto.scm @@ -0,0 +1,230 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-pk-crypto) + #:use-module (guix pk-crypto) + #:use-module (guix utils) + #:use-module (guix hash) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (ice-9 match)) + +;; Test the (guix pk-crypto) module. + +(define %key-pair + ;; Key pair that was generated with: + ;; (generate-key (string->canonical-sexp "(genkey (rsa (nbits 4:1024)))")) + ;; which takes a bit of time. + "(key-data + (public-key + (rsa + (n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#) + (e #010001#))) + (private-key + (rsa + (n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#) + (e #010001#) + (d #58CAD84653D0046A8EC3F9AA82D9C829B145422109FC3F12DA01A694B92FA296E70D366FB166454D30E632CEE3A033B4C41781BA10325F69FCDC0250CA19C8EEB352FA085992494098DB133E682ED38A931701F0DED1A1E508F4341A4FB446A04F019427C7CB3C44F251EEA9D386100DA80F125E0FD5CE1B0DFEC6D21516EACD#) + (p #00D47F185147EC39393CCDA4E7323FFC20FC8B8073E2A54DD63BA392A66975E4204CA48572496A9DFD7522436B852C07472A5AB25B7706F7C14E6F33FBC420FF3B#) + (q #00E9AD22F158060BC9AE3601DA623AFC60FFF3058795802CA92371C00097335CF9A23D7782DE353C9DBA93D7BB99E6A24A411107605E722481C5C191F80D7EB77F#) + (u #59B45B95AE01A7A7370FAFDB08FE73A4793CE37F228961B09B1B1E7DDAD9F8D3E28F5C5E8B4B067E6B8E0BBF3F690B42991A79E46108DDCDA2514323A66964DE#))))") + +(test-begin "pk-crypto") + +(let ((sexps '("(foo bar)" + + ;; In Libgcrypt 1.5.3 the following integer is rendered as + ;; binary, whereas in 1.6.0 it's rendered as is (hexadecimal.) + ;;"#C0FFEE#" + + "(genkey \n (rsa \n (nbits \"1024\")\n )\n )"))) + (test-equal "string->canonical-sexp->string" + sexps + (let ((sexps (map string->canonical-sexp sexps))) + (and (every canonical-sexp? sexps) + (map (compose string-trim-both canonical-sexp->string) sexps))))) + +(gc) ; stress test! + +(let ((sexps `(("(foo bar)" foo -> "(foo bar)") + ("(foo (bar (baz 3:123)))" baz -> "(baz \"123\")") + ("(foo (bar 3:123))" baz -> #f)))) + (test-equal "find-sexp-token" + (map (match-lambda + ((_ _ '-> expected) + expected)) + sexps) + (map (match-lambda + ((input token '-> _) + (let ((sexp (find-sexp-token (string->canonical-sexp input) token))) + (and sexp + (string-trim-both (canonical-sexp->string sexp)))))) + sexps))) + +(gc) + +(test-equal "canonical-sexp-length" + '(0 1 2 4 0 0) + (map (compose canonical-sexp-length string->canonical-sexp) + '("()" "(a)" "(a b)" "(a #616263# b #C001#)" "a" "#123456#"))) + +(test-equal "canonical-sexp-list?" + '(#t #f #t #f) + (map (compose canonical-sexp-list? string->canonical-sexp) + '("()" "\"abc\"" "(a b c)" "#123456#"))) + +(gc) + +(test-equal "canonical-sexp-car + cdr" + '("(b \n (c xyz)\n )") + (let ((lst (string->canonical-sexp "(a (b (c xyz)))"))) + (map (lambda (sexp) + (and sexp (string-trim-both (canonical-sexp->string sexp)))) + ;; Note: 'car' returns #f when the first element is an atom. + (list (canonical-sexp-car (canonical-sexp-cdr lst)))))) + +(gc) + +(test-equal "canonical-sexp-nth" + '("(b pqr)" "(c \"456\")" "(d xyz)" #f #f) + + (let ((lst (string->canonical-sexp "(a (b 3:pqr) (c 3:456) (d 3:xyz))"))) + ;; XXX: In Libgcrypt 1.5.3, (canonical-sexp-nth lst 0) returns LST, whereas in + ;; 1.6.0 it returns #f. + (map (lambda (sexp) + (and sexp (string-trim-both (canonical-sexp->string sexp)))) + (unfold (cut > <> 5) + (cut canonical-sexp-nth lst <>) + 1+ + 1)))) + +(gc) + +(test-equal "canonical-sexp-nth-data" + `(Name Otto Meier #f ,(base16-string->bytevector "123456") #f) + (let ((lst (string->canonical-sexp + "(Name Otto Meier (address Burgplatz) #123456#)"))) + (unfold (cut > <> 5) + (cut canonical-sexp-nth-data lst <>) + 1+ + 0))) + +(gc) + +;; XXX: The test below is typically too long as it needs to gather enough entropy. + +;; (test-assert "generate-key" +;; (let ((key (generate-key (string->canonical-sexp +;; "(genkey (rsa (nbits 3:128)))")))) +;; (and (canonical-sexp? key) +;; (find-sexp-token key 'key-data) +;; (find-sexp-token key 'public-key) +;; (find-sexp-token key 'private-key)))) + +(test-assert "bytevector->hash-data->bytevector" + (let* ((bv (sha256 (string->utf8 "Hello, world."))) + (data (bytevector->hash-data bv "sha256"))) + (and (canonical-sexp? data) + (let-values (((value algo) (hash-data->bytevector data))) + (and (string=? algo "sha256") + (bytevector=? value bv)))))) + +(test-assert "sign + verify" + (let* ((pair (string->canonical-sexp %key-pair)) + (secret (find-sexp-token pair 'private-key)) + (public (find-sexp-token pair 'public-key)) + (data (bytevector->hash-data + (sha256 (string->utf8 "Hello, world.")))) + (sig (sign data secret))) + (and (verify sig data public) + (not (verify sig + (bytevector->hash-data + (sha256 (string->utf8 "Hi!"))) + public))))) + +(gc) + +(test-equal "canonical-sexp->sexp" + `((data + (flags pkcs1) + (hash sha256 + ,(base16-string->bytevector + "2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb"))) + + (public-key + (rsa + (n ,(base16-string->bytevector + (string-downcase + "00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45"))) + (e ,(base16-string->bytevector + "010001"))))) + + (list (canonical-sexp->sexp + (string->canonical-sexp + "(data + (flags pkcs1) + (hash \"sha256\" + #2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb#))")) + + (canonical-sexp->sexp + (find-sexp-token (string->canonical-sexp %key-pair) + 'public-key)))) + + +(let ((lst + `((data + (flags pkcs1) + (hash sha256 + ,(base16-string->bytevector + "2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb"))) + + (public-key + (rsa + (n ,(base16-string->bytevector + (string-downcase + "00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45"))) + (e ,(base16-string->bytevector + "010001")))) + + ,(base16-string->bytevector + "2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb")))) + (test-equal "sexp->canonical-sexp->sexp" + lst + (map (compose canonical-sexp->sexp sexp->canonical-sexp) + lst))) + +(let ((sexp `(signature + (public-key + (rsa + (n ,(make-bytevector 1024 1)) + (e ,(base16-string->bytevector "010001"))))))) + (test-equal "https://bugs.g10code.com/gnupg/issue1594" + ;; The gcrypt bug above was primarily affecting our uses in + ;; 'canonical-sexp->sexp', typically when applied to a signature sexp (in + ;; 'guix authenticate -verify') with a "big" RSA key, such as 4096 bits. + sexp + (canonical-sexp->sexp (sexp->canonical-sexp sexp)))) + +(test-end) + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) diff --git a/tests/pki.scm b/tests/pki.scm new file mode 100644 index 0000000000..04d5a5311b --- /dev/null +++ b/tests/pki.scm @@ -0,0 +1,51 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-pki) + #:use-module (guix pki) + #:use-module (guix pk-crypto) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-64)) + +;; Test the (guix pki) module. + +(define %public-key + (call-with-input-file %public-key-file + (compose string->canonical-sexp + get-string-all))) + +(test-begin "pki") + +(test-assert "current-acl" + (not (not (member (canonical-sexp->sexp %public-key) + (map canonical-sexp->sexp + (acl->public-keys (current-acl))))))) + +(test-assert "authorized-key? public-key current-acl" + (authorized-key? %public-key)) + +(test-assert "authorized-key? public-key empty-acl" + (not (authorized-key? %public-key (public-keys->acl '())))) + +(test-assert "authorized-key? public-key singleton" + (authorized-key? %public-key (public-keys->acl (list %public-key)))) + +(test-end) + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) diff --git a/tests/signing-key.pub b/tests/signing-key.pub new file mode 100644 index 0000000000..092424a15d --- /dev/null +++ b/tests/signing-key.pub @@ -0,0 +1,4 @@ +(public-key + (rsa + (n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#) + (e #010001#))) diff --git a/tests/signing-key.sec b/tests/signing-key.sec new file mode 100644 index 0000000000..558e189102 --- /dev/null +++ b/tests/signing-key.sec @@ -0,0 +1,8 @@ +(private-key + (rsa + (n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#) + (e #010001#) + (d #58CAD84653D0046A8EC3F9AA82D9C829B145422109FC3F12DA01A694B92FA296E70D366FB166454D30E632CEE3A033B4C41781BA10325F69FCDC0250CA19C8EEB352FA085992494098DB133E682ED38A931701F0DED1A1E508F4341A4FB446A04F019427C7CB3C44F251EEA9D386100DA80F125E0FD5CE1B0DFEC6D21516EACD#) + (p #00D47F185147EC39393CCDA4E7323FFC20FC8B8073E2A54DD63BA392A66975E4204CA48572496A9DFD7522436B852C07472A5AB25B7706F7C14E6F33FBC420FF3B#) + (q #00E9AD22F158060BC9AE3601DA623AFC60FFF3058795802CA92371C00097335CF9A23D7782DE353C9DBA93D7BB99E6A24A411107605E722481C5C191F80D7EB77F#) + (u #59B45B95AE01A7A7370FAFDB08FE73A4793CE37F228961B09B1B1E7DDAD9F8D3E28F5C5E8B4B067E6B8E0BBF3F690B42991A79E46108DDCDA2514323A66964DE#))) diff --git a/tests/store.scm b/tests/store.scm index 281b923c28..4bd739e7f6 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -28,10 +28,12 @@ #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (web uri) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-64)) @@ -344,6 +346,49 @@ Deriver: ~a~%" (build-derivations s (list d)) #f)))) +(test-assert "export/import several paths" + (let* ((texts (unfold (cut >= <> 10) + (lambda _ (random-text)) + 1+ + 0)) + (files (map (cut add-text-to-store %store "text" <>) texts)) + (dump (call-with-bytevector-output-port + (cut export-paths %store files <>)))) + (delete-paths %store files) + (and (every (negate file-exists?) files) + (let* ((source (open-bytevector-input-port dump)) + (imported (import-paths %store source))) + (and (equal? imported files) + (every file-exists? files) + (equal? texts + (map (lambda (file) + (call-with-input-file file + get-string-all)) + files))))))) + +(test-assert "import corrupt path" + (let* ((text (random-text)) + (file (add-text-to-store %store "text" text)) + (dump (call-with-bytevector-output-port + (cut export-paths %store (list file) <>)))) + (delete-paths %store (list file)) + + ;; Flip a bit in the stream's payload. + (let* ((index (quotient (bytevector-length dump) 4)) + (byte (bytevector-u8-ref dump index))) + (bytevector-u8-set! dump index (logxor #xff byte))) + + (and (not (file-exists? file)) + (guard (c ((nix-protocol-error? c) + (pk 'c c) + (and (not (zero? (nix-protocol-error-status c))) + (string-contains (nix-protocol-error-message c) + "corrupt")))) + (let* ((source (open-bytevector-input-port dump)) + (imported (import-paths %store source))) + (pk 'corrupt-imported imported) + #f))))) + (test-end "store") |