1 ;;; gnutls-tests.el --- Test suite for gnutls.el
3 ;; Copyright (C) 2017 Free Software Foundation, Inc.
5 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
24 ;; Run this with `GNUTLS_TEST_VERBOSE=1' to get verbose debugging.
33 (defvar gnutls-tests-message-prefix
"")
35 (defsubst gnutls-tests-message
(format-string &rest args
)
36 (when (getenv "GNUTLS_TEST_VERBOSE")
37 (apply #'message
(concat "gnutls-tests: " gnutls-tests-message-prefix format-string
) args
)))
39 ;; Minor convenience to see strings more easily (without binary data).
40 (defsubst gnutls-tests-hexstring-equal
(a b
)
41 (and (stringp a
) (stringp b
) (string-equal (encode-hex-string a
) (encode-hex-string b
))))
43 (defvar gnutls-tests-internal-macs-upcased
44 (mapcar (lambda (sym) (cons sym
(intern (upcase (symbol-name sym
)))))
45 (secure-hash-algorithms)))
47 (defvar gnutls-tests-tested-macs
48 (when (gnutls-available-p)
50 (append (mapcar #'cdr gnutls-tests-internal-macs-upcased
)
51 (mapcar #'car
(gnutls-macs))))))
53 (defvar gnutls-tests-tested-digests
54 (when (gnutls-available-p)
56 (append (mapcar #'cdr gnutls-tests-internal-macs-upcased
)
57 (mapcar #'car
(gnutls-digests))))))
59 (defvar gnutls-tests-tested-ciphers
60 (when (gnutls-available-p)
62 ;; these cause FPEs or SEGVs
63 (cl-remove-if (lambda (e) (memq e
'(ARCFOUR-128)))
64 (mapcar #'car
(gnutls-ciphers))))))
66 (defvar gnutls-tests-mondo-strings
70 "lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data "
71 "data and more data to go over the block limit!"
72 "data and more data to go over the block limit"
73 (format "some random data %d%d" (random) (random))))
75 (ert-deftest test-gnutls-000-availability
()
76 "Test the GnuTLS hashes and ciphers availability."
77 (skip-unless (memq 'gnutls3
(gnutls-available-p)))
78 (setq gnutls-tests-message-prefix
"availability: ")
79 (should (> (length gnutls-tests-internal-macs-upcased
) 5))
80 (let ((macs (gnutls-macs))
81 (digests (gnutls-digests))
82 (ciphers (gnutls-ciphers)))
83 (dolist (mac gnutls-tests-tested-macs
)
84 (let ((plist (cdr (assq mac macs
))))
85 (gnutls-tests-message "MAC %s %S" mac plist
)
86 (dolist (prop '(:mac-algorithm-id
:mac-algorithm-length
:mac-algorithm-keysize
:mac-algorithm-noncesize
))
87 (should (plist-get plist prop
)))
88 (should (eq 'gnutls-mac-algorithm
(plist-get plist
:type
)))))
89 (dolist (digest gnutls-tests-tested-digests
)
90 (let ((plist (cdr (assq digest digests
))))
91 (gnutls-tests-message "digest %s %S" digest plist
)
92 (dolist (prop '(:digest-algorithm-id
:digest-algorithm-length
))
93 (should (plist-get plist prop
)))
94 (should (eq 'gnutls-digest-algorithm
(plist-get plist
:type
)))))
95 (dolist (cipher gnutls-tests-tested-ciphers
)
96 (let ((plist (cdr (assq cipher ciphers
))))
97 (gnutls-tests-message "cipher %s %S" cipher plist
)
98 (dolist (prop '(:cipher-id
:cipher-blocksize
:cipher-keysize
:cipher-ivsize
))
99 (should (plist-get plist prop
)))
100 (should (eq 'gnutls-symmetric-cipher
(plist-get plist
:type
)))))))
102 (ert-deftest test-gnutls-000-data-extractions
()
103 "Test the GnuTLS data extractions against the built-in `secure-hash'."
104 (skip-unless (memq 'digests
(gnutls-available-p)))
105 (setq gnutls-tests-message-prefix
"data extraction: ")
106 (dolist (input gnutls-tests-mondo-strings
)
107 ;; Test buffer extraction
110 (insert "not ASCII: не e английски")
111 (dolist (step '(0 1 2 3 4 5))
112 (let ((spec (list (current-buffer) ; a buffer spec
114 (max (point-min) (- step
(point-max)))))
115 (spec2 (list (buffer-string) ; a string spec
117 (max (point-min) (- step
(point-max))))))
118 (should (gnutls-tests-hexstring-equal
119 (gnutls-hash-digest 'MD5 spec
)
120 (apply 'secure-hash
'md5
(append spec
'(t)))))
121 (should (gnutls-tests-hexstring-equal
122 (gnutls-hash-digest 'MD5 spec2
)
123 (apply 'secure-hash
'md5
(append spec2
'(t))))))))))
125 (ert-deftest test-gnutls-001-hashes-internal-digests
()
126 "Test the GnuTLS hash digests against the built-in `secure-hash'."
127 (skip-unless (memq 'digests
(gnutls-available-p)))
128 (setq gnutls-tests-message-prefix
"digest internal verification: ")
129 (let ((macs (gnutls-macs)))
130 (dolist (mcell gnutls-tests-internal-macs-upcased
)
131 (let ((plist (cdr (assq (cdr mcell
) macs
))))
132 (gnutls-tests-message "Checking digest MAC %S %S" mcell plist
)
133 (dolist (input gnutls-tests-mondo-strings
)
134 ;; Test buffer extraction
137 (should (gnutls-tests-hexstring-equal
138 (gnutls-hash-digest (cdr mcell
) (current-buffer))
139 (secure-hash (car mcell
) (current-buffer) nil nil t
))))
140 (should (gnutls-tests-hexstring-equal
141 (gnutls-hash-digest (cdr mcell
) input
)
142 (secure-hash (car mcell
) input nil nil t
))))))))
144 (ert-deftest test-gnutls-002-hashes-digests
()
145 "Test some GnuTLS hash digests against pre-defined outputs."
146 (skip-unless (memq 'digests
(gnutls-available-p)))
147 (setq gnutls-tests-message-prefix
"digest external verification: ")
148 (let ((macs (gnutls-macs)))
149 (dolist (test '(("57edf4a22be3c955ac49da2e2107b67a" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" MD5
)
150 ("d174ab98d277d9f5a5611c2c9f419d9f" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" MD5
)
151 ("c3fcd3d76192e4007dfb496cca67e13b" "abcdefghijklmnopqrstuvwxyz" MD5
)
152 ("f96b697d7cb7938d525a2f31aaf161d0" "message digest" MD5
)
153 ("900150983cd24fb0d6963f7d28e17f72" "abc" MD5
)
154 ("0cc175b9c0f1b6a831c399e269772661" "a" MD5
)
155 ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" SHA1
)
156 ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" "SHA1"))) ; check string ID for digest
157 (pcase-let ((`(,hash
,input
,mac
) test
))
158 (let ((plist (cdr (assq mac macs
)))
160 (gnutls-tests-message "%s %S" mac plist
)
161 (setq result
(encode-hex-string (gnutls-hash-digest mac input
)))
162 (gnutls-tests-message "%S => result %S" test result
)
163 (should (string-equal result hash
))
164 ;; Test buffer extraction
167 (setq resultb
(encode-hex-string (gnutls-hash-digest mac
(current-buffer))))
168 (gnutls-tests-message "%S => result from buffer %S" test resultb
)
169 (should (string-equal resultb hash
))))))))
171 (ert-deftest test-gnutls-003-hashes-hmacs
()
172 "Test some predefined GnuTLS HMAC outputs for SHA256."
173 (skip-unless (memq 'macs
(gnutls-available-p)))
174 (setq gnutls-tests-message-prefix
"HMAC verification: ")
175 (let ((macs (gnutls-macs)))
176 (dolist (test '(("f5c5021e60d9686fef3bb0414275fe4163bece61d9a95fec7a273746a437b986" "hello\n" "test" SHA256
)
177 ("46b75292b81002fd873e89c532a1b8545d6efc9822ee938feba6de2723161a67" "more and more data goes into a file to exceed the buffer size" "test" SHA256
)
178 ("81568ba71fa2c5f33cc84bf362466988f98eba3735479100b4e8908acad87ac4" "more and more data goes into a file to exceed the buffer size" "very long key goes here to exceed the key size" SHA256
)
179 ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" "SHA256") ; check string ID for HMAC
180 ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" SHA256
)))
181 (pcase-let ((`(,hash
,input
,key
,mac
) test
))
182 (let ((plist (cdr (assq mac macs
)))
184 (gnutls-tests-message "%s %S" mac plist
)
185 (setq result
(encode-hex-string (gnutls-hash-mac mac
(copy-sequence key
) input
)))
186 (gnutls-tests-message "%S => result %S" test result
)
187 (should (string-equal result hash
)))))))
190 (defun gnutls-tests-pad-or-trim (s exact
)
191 "Pad or trim string S to EXACT numeric size."
192 (if (and (consp s
) (eq 'iv-auto
(nth 0 s
)))
194 (let ((e (number-to-string exact
)))
195 (format (concat "%" e
"." e
"s") s
))))
197 (defun gnutls-tests-pad-to-multiple (s blocksize
)
198 "Pad string S to BLOCKSIZE numeric size."
199 (let* ((e (if (string= s
"")
201 (* blocksize
(ceiling (length s
) blocksize
))))
202 (out (concat s
(make-string (- e
(length s
)) ?
))))
203 ;; (gnutls-tests-message "padding %S to length %d for blocksize %d: => %S" s e blocksize out)
206 ;; ;;; Testing from the command line:
207 ;; ;;; echo e36a9d13c15a6df23a59a6337d6132b8f7cd5283cb4784b81141b52343a18e5f5e5ee8f5553c23167409dd222478bc30 | perl -lne 'print pack "H*", $_' | openssl enc -aes-128-ctr -d -nosalt -K 6d796b657932 -iv 696e697432 | od -x
208 (ert-deftest test-gnutls-004-symmetric-ciphers
()
209 "Test the GnuTLS symmetric ciphers"
210 (skip-unless (memq 'ciphers
(gnutls-available-p)))
211 (setq gnutls-tests-message-prefix
"symmetric cipher verification: ")
212 ;; we expect at least 10 ciphers
213 (should (> (length (gnutls-ciphers)) 10))
214 (let ((keys '("mykey" "mykey2"))
215 (inputs gnutls-tests-mondo-strings
)
216 (ivs '("" "-abc123-" "init" "ini2"))
217 (ciphers (cl-remove-if
218 (lambda (c) (plist-get (cdr (assq c
(gnutls-ciphers)))
219 :cipher-aead-capable
))
220 gnutls-tests-tested-ciphers
)))
222 (dolist (cipher ciphers
)
224 (dolist (input inputs
)
226 (gnutls-tests-message "%S, starting key %S IV %S input %S" (assq cipher
(gnutls-ciphers)) key iv input
)
227 (let* ((cplist (cdr (assq cipher
(gnutls-ciphers))))
228 (key (gnutls-tests-pad-or-trim key
(plist-get cplist
:cipher-keysize
)))
229 (input (gnutls-tests-pad-to-multiple input
(plist-get cplist
:cipher-blocksize
)))
230 (iv (gnutls-tests-pad-or-trim iv
(plist-get cplist
:cipher-ivsize
)))
231 (output (gnutls-symmetric-encrypt cplist
(copy-sequence key
) iv input
))
232 (data (nth 0 output
))
233 (actual-iv (nth 1 output
))
234 (reverse-output (gnutls-symmetric-decrypt cplist
(copy-sequence key
) actual-iv data
))
235 (reverse (nth 0 reverse-output
)))
236 (gnutls-tests-message "%s %S" cipher cplist
)
237 (gnutls-tests-message "key %S IV %S input %S => hexdata %S and reverse %S" key iv input
(encode-hex-string data
) reverse
)
238 (should-not (gnutls-tests-hexstring-equal input data
))
239 (should-not (gnutls-tests-hexstring-equal data reverse
))
240 (should (gnutls-tests-hexstring-equal input reverse
)))))))))
242 (ert-deftest test-gnutls-005-aead-ciphers
()
243 "Test the GnuTLS AEAD ciphers"
244 (skip-unless (memq 'AEAD-ciphers
(gnutls-available-p)))
245 (setq gnutls-tests-message-prefix
"AEAD verification: ")
246 (let ((keys '("mykey" "mykey2"))
247 (inputs gnutls-tests-mondo-strings
)
248 (ivs '("" "-abc123-" "init" "ini2"))
252 "auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data "
253 "AUTH data and more data to go over the block limit!"
254 "AUTH data and more data to go over the block limit"))
255 (ciphers (cl-remove-if
256 (lambda (c) (or (null (plist-get (cdr (assq c
(gnutls-ciphers)))
257 :cipher-aead-capable
))))
258 gnutls-tests-tested-ciphers
))
261 (dolist (cipher ciphers
)
262 (dolist (input inputs
)
265 (let* ((cplist (cdr (assq cipher
(gnutls-ciphers))))
266 (key (gnutls-tests-pad-or-trim key
(plist-get cplist
:cipher-keysize
)))
267 (input (gnutls-tests-pad-to-multiple input
(plist-get cplist
:cipher-blocksize
)))
268 (ivsize (plist-get cplist
:cipher-ivsize
)))
269 (should (>= ivsize
12)) ; as per the RFC
270 (dolist (iv (append ivs
(list (list 'iv-auto ivsize
))))
272 (gnutls-tests-message "%S, starting key %S IV %S input %S auth %S" (assq cipher
(gnutls-ciphers)) key iv input auth
)
273 (let* ((iv (gnutls-tests-pad-or-trim iv
(plist-get cplist
:cipher-ivsize
)))
274 (output (gnutls-symmetric-encrypt cplist
(copy-sequence key
) iv input
(copy-sequence auth
)))
275 (data (nth 0 output
))
276 (actual-iv (nth 1 output
))
277 (reverse-output (gnutls-symmetric-decrypt cplist
(copy-sequence key
) actual-iv data auth
))
278 (reverse (nth 0 reverse-output
)))
279 ;; GNUTLS_RND_NONCE should be good enough to ensure this.
280 (should-not (member (secure-hash 'sha384 actual-iv
0 ivsize
) actual-ivlist
))
283 (should (equal iv actual-iv
)))
285 (push (secure-hash 'sha384 actual-iv
0 ivsize
) actual-ivlist
)
286 (gnutls-tests-message "IV list length: %d" (length actual-ivlist
))))
288 (gnutls-tests-message "%s %S" cipher cplist
)
289 (gnutls-tests-message "key %S IV %S input %S auth %S => hexdata %S and reverse %S" key iv input auth
(encode-hex-string data
) reverse
)
290 (should-not (gnutls-tests-hexstring-equal input data
))
291 (should-not (gnutls-tests-hexstring-equal data reverse
))
292 (should (gnutls-tests-hexstring-equal input reverse
)))))))))))
294 (provide 'gnutls-tests
)
295 ;;; gnutls-tests.el ends here