From: Taylor R Campbell Date: Tue, 28 Nov 2017 05:08:59 +0000 (+0000) Subject: Add standard Blowfish tests. X-Git-Tag: mit-scheme-pucked-9.2.12~14^2~6 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fe0880b3a18df042749b5050166e66e8667e002c;p=mit-scheme.git Add standard Blowfish tests. --- diff --git a/tests/check.scm b/tests/check.scm index 48ea077bc..f1f0893bc 100644 --- a/tests/check.scm +++ b/tests/check.scm @@ -48,6 +48,7 @@ USA. "microcode/test-keccak" "microcode/test-lookup" "runtime/test-arith" + "runtime/test-blowfish" "runtime/test-bytevector" ("runtime/test-char" (runtime)) ("runtime/test-char-set" (runtime character-set)) diff --git a/tests/runtime/test-blowfish.scm b/tests/runtime/test-blowfish.scm new file mode 100644 index 000000000..e531dd3bf --- /dev/null +++ b/tests/runtime/test-blowfish.scm @@ -0,0 +1,195 @@ +#| -*-Scheme-*- + +Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, + 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, + 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, + 2017 Massachusetts Institute of Technology + +This file is part of MIT/GNU Scheme. + +MIT/GNU Scheme 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 2 of the License, or (at +your option) any later version. + +MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, +USA. + +|# + +;;;; Tests of Blowfish + +(define (define-bf-test name procedure) + (if (blowfish-available?) + (define-test name procedure))) + +(define (define-variable-key-test i c) + (define k24 + #u8(#xF0 #xE1 #xD2 #xC3 #xB4 #xA5 #x96 #x87 + #x78 #x69 #x5A #x4B #x3C #x2D #x1E #x0F + #x00 #x11 #x22 #x33 #x44 #x55 #x66 #x77)) + (define p24 #u8(#xFE #xDC #xBA #x98 #x76 #x54 #x32 #x10)) + (let ((k (bytevector-copy k24 0 i)) + (p p24)) + (define-bf-test (symbol 'VARIABLE-KEY ': i ': 'ENCRYPT) + (lambda () + (let ((bf (blowfish-set-key k)) + (buf (make-bytevector 8))) + (blowfish-ecb p buf bf #t) + (assert-equal buf c)))) + (define-bf-test (symbol 'VARIABLE-KEY ': i ': 'DECRYPT) + (lambda () + (let ((bf (blowfish-set-key k)) + (buf (make-bytevector 8))) + (blowfish-ecb c buf bf #f) + (assert-equal buf p)))))) + +(define-variable-key-test 1 #u8(#xF9 #xAD #x59 #x7C #x49 #xDB #x00 #x5E)) +(define-variable-key-test 2 #u8(#xE9 #x1D #x21 #xC1 #xD9 #x61 #xA6 #xD6)) +(define-variable-key-test 3 #u8(#xE9 #xC2 #xB7 #x0A #x1B #xC6 #x5C #xF3)) +(define-variable-key-test 4 #u8(#xBE #x1E #x63 #x94 #x08 #x64 #x0F #x05)) +(define-variable-key-test 5 #u8(#xB3 #x9E #x44 #x48 #x1B #xDB #x1E #x6E)) +(define-variable-key-test 6 #u8(#x94 #x57 #xAA #x83 #xB1 #x92 #x8C #x0D)) +(define-variable-key-test 7 #u8(#x8B #xB7 #x70 #x32 #xF9 #x60 #x62 #x9D)) +(define-variable-key-test 8 #u8(#xE8 #x7A #x24 #x4E #x2C #xC8 #x5E #x82)) +(define-variable-key-test 9 #u8(#x15 #x75 #x0E #x7A #x4F #x4E #xC5 #x77)) +(define-variable-key-test 10 #u8(#x12 #x2B #xA7 #x0B #x3A #xB6 #x4A #xE0)) +(define-variable-key-test 11 #u8(#x3A #x83 #x3C #x9A #xFF #xC5 #x37 #xF6)) +(define-variable-key-test 12 #u8(#x94 #x09 #xDA #x87 #xA9 #x0F #x6B #xF2)) +(define-variable-key-test 13 #u8(#x88 #x4F #x80 #x62 #x50 #x60 #xB8 #xB4)) +(define-variable-key-test 14 #u8(#x1F #x85 #x03 #x1C #x19 #xE1 #x19 #x68)) +(define-variable-key-test 15 #u8(#x79 #xD9 #x37 #x3A #x71 #x4C #xA3 #x4F)) +(define-variable-key-test 16 #u8(#x93 #x14 #x28 #x87 #xEE #x3B #xE1 #x5C)) +(define-variable-key-test 17 #u8(#x03 #x42 #x9E #x83 #x8C #xE2 #xD1 #x4B)) +(define-variable-key-test 18 #u8(#xA4 #x29 #x9E #x27 #x46 #x9F #xF6 #x7B)) +(define-variable-key-test 19 #u8(#xAF #xD5 #xAE #xD1 #xC1 #xBC #x96 #xA8)) +(define-variable-key-test 20 #u8(#x10 #x85 #x1C #x0E #x38 #x58 #xDA #x9F)) +(define-variable-key-test 21 #u8(#xE6 #xF5 #x1E #xD7 #x9B #x9D #xB2 #x1F)) +(define-variable-key-test 22 #u8(#x64 #xA6 #xE1 #x4A #xFD #x36 #xB4 #x6F)) +(define-variable-key-test 23 #u8(#x80 #xC7 #xD7 #xD4 #x5A #x54 #x79 #xAD)) +(define-variable-key-test 24 #u8(#x05 #x04 #x4B #x62 #xFA #x52 #xD0 #x80)) + +((lambda (ks ps cs) + ((lambda (doit) (for-each doit (iota (length ks)) ks ps cs)) + (lambda (i k p c) + (define-bf-test (symbol 'ENCRYPT ': i) + (lambda () + (let ((bf (blowfish-set-key k)) + (buf (make-bytevector 8))) + (blowfish-ecb p buf bf #t) + (assert-equal buf c)))) + (define-bf-test (symbol 'DECRYPT ': i) + (lambda () + (let ((bf (blowfish-set-key k)) + (buf (make-bytevector 8))) + (blowfish-ecb c buf bf #f) + (assert-equal buf p))))))) + '(#u8(#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00) + #u8(#xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF) + #u8(#x30 #x00 #x00 #x00 #x00 #x00 #x00 #x00) + #u8(#x11 #x11 #x11 #x11 #x11 #x11 #x11 #x11) + #u8(#x01 #x23 #x45 #x67 #x89 #xAB #xCD #xEF) + #u8(#x11 #x11 #x11 #x11 #x11 #x11 #x11 #x11) + #u8(#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00) + #u8(#xFE #xDC #xBA #x98 #x76 #x54 #x32 #x10) + #u8(#x7C #xA1 #x10 #x45 #x4A #x1A #x6E #x57) + #u8(#x01 #x31 #xD9 #x61 #x9D #xC1 #x37 #x6E) + #u8(#x07 #xA1 #x13 #x3E #x4A #x0B #x26 #x86) + #u8(#x38 #x49 #x67 #x4C #x26 #x02 #x31 #x9E) + #u8(#x04 #xB9 #x15 #xBA #x43 #xFE #xB5 #xB6) + #u8(#x01 #x13 #xB9 #x70 #xFD #x34 #xF2 #xCE) + #u8(#x01 #x70 #xF1 #x75 #x46 #x8F #xB5 #xE6) + #u8(#x43 #x29 #x7F #xAD #x38 #xE3 #x73 #xFE) + #u8(#x07 #xA7 #x13 #x70 #x45 #xDA #x2A #x16) + #u8(#x04 #x68 #x91 #x04 #xC2 #xFD #x3B #x2F) + #u8(#x37 #xD0 #x6B #xB5 #x16 #xCB #x75 #x46) + #u8(#x1F #x08 #x26 #x0D #x1A #xC2 #x46 #x5E) + #u8(#x58 #x40 #x23 #x64 #x1A #xBA #x61 #x76) + #u8(#x02 #x58 #x16 #x16 #x46 #x29 #xB0 #x07) + #u8(#x49 #x79 #x3E #xBC #x79 #xB3 #x25 #x8F) + #u8(#x4F #xB0 #x5E #x15 #x15 #xAB #x73 #xA7) + #u8(#x49 #xE9 #x5D #x6D #x4C #xA2 #x29 #xBF) + #u8(#x01 #x83 #x10 #xDC #x40 #x9B #x26 #xD6) + #u8(#x1C #x58 #x7F #x1C #x13 #x92 #x4F #xEF) + #u8(#x01 #x01 #x01 #x01 #x01 #x01 #x01 #x01) + #u8(#x1F #x1F #x1F #x1F #x0E #x0E #x0E #x0E) + #u8(#xE0 #xFE #xE0 #xFE #xF1 #xFE #xF1 #xFE) + #u8(#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00) + #u8(#xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF) + #u8(#x01 #x23 #x45 #x67 #x89 #xAB #xCD #xEF) + #u8(#xFE #xDC #xBA #x98 #x76 #x54 #x32 #x10)) + '(#u8(#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00) + #u8(#xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF) + #u8(#x10 #x00 #x00 #x00 #x00 #x00 #x00 #x01) + #u8(#x11 #x11 #x11 #x11 #x11 #x11 #x11 #x11) + #u8(#x11 #x11 #x11 #x11 #x11 #x11 #x11 #x11) + #u8(#x01 #x23 #x45 #x67 #x89 #xAB #xCD #xEF) + #u8(#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00) + #u8(#x01 #x23 #x45 #x67 #x89 #xAB #xCD #xEF) + #u8(#x01 #xA1 #xD6 #xD0 #x39 #x77 #x67 #x42) + #u8(#x5C #xD5 #x4C #xA8 #x3D #xEF #x57 #xDA) + #u8(#x02 #x48 #xD4 #x38 #x06 #xF6 #x71 #x72) + #u8(#x51 #x45 #x4B #x58 #x2D #xDF #x44 #x0A) + #u8(#x42 #xFD #x44 #x30 #x59 #x57 #x7F #xA2) + #u8(#x05 #x9B #x5E #x08 #x51 #xCF #x14 #x3A) + #u8(#x07 #x56 #xD8 #xE0 #x77 #x47 #x61 #xD2) + #u8(#x76 #x25 #x14 #xB8 #x29 #xBF #x48 #x6A) + #u8(#x3B #xDD #x11 #x90 #x49 #x37 #x28 #x02) + #u8(#x26 #x95 #x5F #x68 #x35 #xAF #x60 #x9A) + #u8(#x16 #x4D #x5E #x40 #x4F #x27 #x52 #x32) + #u8(#x6B #x05 #x6E #x18 #x75 #x9F #x5C #xCA) + #u8(#x00 #x4B #xD6 #xEF #x09 #x17 #x60 #x62) + #u8(#x48 #x0D #x39 #x00 #x6E #xE7 #x62 #xF2) + #u8(#x43 #x75 #x40 #xC8 #x69 #x8F #x3C #xFA) + #u8(#x07 #x2D #x43 #xA0 #x77 #x07 #x52 #x92) + #u8(#x02 #xFE #x55 #x77 #x81 #x17 #xF1 #x2A) + #u8(#x1D #x9D #x5C #x50 #x18 #xF7 #x28 #xC2) + #u8(#x30 #x55 #x32 #x28 #x6D #x6F #x29 #x5A) + #u8(#x01 #x23 #x45 #x67 #x89 #xAB #xCD #xEF) + #u8(#x01 #x23 #x45 #x67 #x89 #xAB #xCD #xEF) + #u8(#x01 #x23 #x45 #x67 #x89 #xAB #xCD #xEF) + #u8(#xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF) + #u8(#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00) + #u8(#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00) + #u8(#xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF)) + '(#u8(#x4E #xF9 #x97 #x45 #x61 #x98 #xDD #x78) + #u8(#x51 #x86 #x6F #xD5 #xB8 #x5E #xCB #x8A) + #u8(#x7D #x85 #x6F #x9A #x61 #x30 #x63 #xF2) + #u8(#x24 #x66 #xDD #x87 #x8B #x96 #x3C #x9D) + #u8(#x61 #xF9 #xC3 #x80 #x22 #x81 #xB0 #x96) + #u8(#x7D #x0C #xC6 #x30 #xAF #xDA #x1E #xC7) + #u8(#x4E #xF9 #x97 #x45 #x61 #x98 #xDD #x78) + #u8(#x0A #xCE #xAB #x0F #xC6 #xA0 #xA2 #x8D) + #u8(#x59 #xC6 #x82 #x45 #xEB #x05 #x28 #x2B) + #u8(#xB1 #xB8 #xCC #x0B #x25 #x0F #x09 #xA0) + #u8(#x17 #x30 #xE5 #x77 #x8B #xEA #x1D #xA4) + #u8(#xA2 #x5E #x78 #x56 #xCF #x26 #x51 #xEB) + #u8(#x35 #x38 #x82 #xB1 #x09 #xCE #x8F #x1A) + #u8(#x48 #xF4 #xD0 #x88 #x4C #x37 #x99 #x18) + #u8(#x43 #x21 #x93 #xB7 #x89 #x51 #xFC #x98) + #u8(#x13 #xF0 #x41 #x54 #xD6 #x9D #x1A #xE5) + #u8(#x2E #xED #xDA #x93 #xFF #xD3 #x9C #x79) + #u8(#xD8 #x87 #xE0 #x39 #x3C #x2D #xA6 #xE3) + #u8(#x5F #x99 #xD0 #x4F #x5B #x16 #x39 #x69) + #u8(#x4A #x05 #x7A #x3B #x24 #xD3 #x97 #x7B) + #u8(#x45 #x20 #x31 #xC1 #xE4 #xFA #xDA #x8E) + #u8(#x75 #x55 #xAE #x39 #xF5 #x9B #x87 #xBD) + #u8(#x53 #xC5 #x5F #x9C #xB4 #x9F #xC0 #x19) + #u8(#x7A #x8E #x7B #xFA #x93 #x7E #x89 #xA3) + #u8(#xCF #x9C #x5D #x7A #x49 #x86 #xAD #xB5) + #u8(#xD1 #xAB #xB2 #x90 #x65 #x8B #xC7 #x78) + #u8(#x55 #xCB #x37 #x74 #xD1 #x3E #xF2 #x01) + #u8(#xFA #x34 #xEC #x48 #x47 #xB2 #x68 #xB2) + #u8(#xA7 #x90 #x79 #x51 #x08 #xEA #x3C #xAE) + #u8(#xC3 #x9E #x07 #x2D #x9F #xAC #x63 #x1D) + #u8(#x01 #x49 #x33 #xE0 #xCD #xAF #xF6 #xE4) + #u8(#xF2 #x1E #x9A #x77 #xB7 #x1C #x49 #xBC) + #u8(#x24 #x59 #x46 #x88 #x57 #x54 #x36 #x9A) + #u8(#x6B #x5C #x5A #x9C #x5D #x9E #x0A #x5A)))