- Timestamp:
- 04/27/20 21:14:13 (9 months ago)
- Location:
- release/5/crypto-tools/trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/crypto-tools/trunk/crypto-tools.egg
r36348 r38658 1 1 ((license "BSD") 2 (category crypt) 3 (author "Alaric Snell-Pym") 4 (synopsis "Useful cryptographic primitives") 5 (version "1.3") 6 (components (extension crypto-tools (csc-options "-O2" "-d1")))) 2 (category crypt) 3 (author "Alaric Snell-Pym") 4 (synopsis "Useful cryptographic primitives") 5 (version "1.4") 6 (components 7 (extension crypto-tools 8 (csc-options "-O2" "-d1") 9 (linkage dynamic)))) -
release/5/crypto-tools/trunk/crypto-tools.scm
r36348 r38658 1 1 (module crypto-tools 2 2 (blob->hexstring blob->hexstring/uppercase hexstring->blob 3 blob-xor blob-pad blob-unpad 4 make-cbc-encryptor make-cbc-decryptor 5 make-c bc*-encryptor make-cbc*-decryptor)3 blob-xor blob-pad blob-unpad blob-pkcs5-pad blob-pkcs5-unpad no-pad no-unpad 4 make-cbc-encryptor make-cbc-decryptor make-cbc*-encryptor make-cbc*-decryptor 5 make-ctr-encryptor make-ctr-decryptor make-ctr*-encryptor make-ctr*-decryptor) 6 6 7 7 (import scheme) 8 8 (import (chicken foreign)) 9 (import (chicken blob)) 9 10 (import (chicken base)) 10 (import (chicken blob))11 11 (import (chicken format)) 12 (import (chicken locative)) 12 13 (import (chicken memory)) 13 (import (chicken locative)) 14 14 15 ;zero sizes blob 15 16 (define *the-null-blob* (make-blob 0)) 16 17 18 ;ensures the input is a blob of certain size 17 19 (define (check-blob blob len function) 18 20 (if (blob? blob) … … 22 24 (error (sprintf "~A: Input was not a blob" function)))) 23 25 26 ;allocates a new string where every byte of the blob is encoded as a two char hex number 24 27 (define (blob->hexstring blob) 25 28 (if (zero? (blob-size blob)) … … 35 38 str))) 36 39 40 ;same as blob->hexstring but with uppercase hex chars 37 41 (define (blob->hexstring/uppercase blob) 38 42 (if (zero? (blob-size blob)) … … 48 52 str))) 49 53 54 ;converts a hex encoded string of two chars per byte to a blob 50 55 (define (hexstring->blob string) 51 56 (let ((len (string-length string))) … … 79 84 blob)))))) 80 85 86 ;makes a new blob and copies in it part of the contents of the original 81 87 (define (subblob blob offset length) 82 88 (if (not (blob? blob)) (error "subblob: Argument must be a blob")) 83 (if (> (+ offset length) (blob-size blob)) (error (sprintf "subblob: Argument must be large enough: ~A bytes supplied, but cutting out ~A bytes from ~A would need ~A" (blob-size blob) length offset (+ length offset)))) 84 85 (cond 86 ((and (zero? offset) (= (blob-size blob) length)) 87 blob) 88 ((zero? length) 89 *the-null-blob*) 90 (else 91 (let ((out (make-blob length))) 92 (move-memory! blob out length offset 0) 93 out)))) 94 89 (if (> (+ offset length) (blob-size blob)) 90 (error (sprintf "subblob: Argument must be large enough: ~A bytes supplied, but cutting out ~A bytes from ~A would need ~A" (blob-size blob) length offset (+ length offset)))) 91 (cond 92 ((and (zero? offset) (= (blob-size blob) length)) 93 blob) 94 ((zero? length) 95 *the-null-blob*) 96 (else 97 (let ((out (make-blob length))) 98 (move-memory! blob out length offset 0) 99 out)))) 100 101 ;makes a new blob with contetns the xor of the arguments up to the length of the smallest one. 95 102 (define (blob-xor a b) 96 (if (not (blob? a)) (error "blob-xor: Arguments must be blobs of the same size")) 97 (check-blob b (blob-size a) 'blob-xor) 98 99 (let ((out (make-blob (blob-size a)))) 103 (if (not (blob? a)) (error "blob-xor: Arguments must be blobs")) 104 (if (= (blob-size a) 0) b) 105 (if (= (blob-size b) 0) a) 106 ;(check-blob b (blob-size a) 'blob-xor) 107 (let* ((minlen (min (blob-size a) (blob-size b))) 108 (out (make-blob minlen))) 100 109 ((foreign-lambda* void ((int len) (blob a) (blob b) (blob out)) " 101 110 while (len--) { 102 111 (*out++) = (*a++) ^ (*b++); 103 112 } 104 ") (blob-size a)a b out)113 ") minlen a b out) 105 114 out)) 106 115 116 ;pads a blob with the a value of the number of bytes of that pad. 117 ;in case a whole blocklength was added then the padvalue is that blocklength. 118 ;that means that a pad is always present. 119 (define (blob-pkcs5-pad in len) 120 (if (not (blob? in)) (error "blob-pkcs5-pad: Argument must be a blob")) 121 (let* ((inlen (blob-size in)) 122 (extrabytes (remainder inlen len)) 123 (padsz (if (zero? extrabytes) len extrabytes)) 124 (totlen (+ inlen padsz)) 125 (out (make-blob (+ inlen padsz)))) 126 (move-memory! in out inlen 0 0) 127 ((foreign-lambda* void ((int inlen) (int outlen) (int padnum) (blob out)) " 128 while (inlen < outlen) { 129 out[inlen++ - 1] = (char)padnum; 130 } 131 ") inlen totlen padsz out) 132 out)) 133 134 ;unpads by reading the last byte and removing as many as its value 135 (define (blob-pkcs5-unpad in) 136 (if (not (blob? in)) (error "blob-pkcs5-unpad: Argument must be a blob")) 137 (let* ((inlen (blob-size in)) 138 (padsz ((foreign-lambda* int ((blob in) (int inlen)) " 139 char sz; 140 sz = in[inlen-1]; 141 C_return((int)sz); 142 ") in inlen))) 143 (if (or (<= padsz 0) (> padsz inlen)) (error "blob-pkcs5-unpad: Argument must be a validly padded blob. Got:" padsz " insize:" inlen)) 144 (let* ((outlen (- inlen padsz)) 145 (out (make-blob outlen))) 146 (move-memory! in out outlen) 147 out))) 148 149 ;noop. returns the input as is without padding 150 (define (no-pad in len) in) 151 ;noop, returns the input without unpadding 152 (define (no-unpad in) in) 153 154 ;pads by adding the byte 0x80 followed by 0x00 up to the desired length. 107 155 (define (blob-pad in len) 108 156 (if (not (blob? in)) (error "blob-pad: Argument must be a blob")) 109 157 (if (>= (blob-size in) len) (error "blob-pad: Argument must be smaller than the block size")) 110 111 158 (let ((out (make-blob len)) 112 159 (inlen (blob-size in))) … … 120 167 out)) 121 168 169 ;unpads by removing 0x00 until it discovers a 0x80 byte 122 170 (define (blob-unpad in) 123 171 (if (not (blob? in)) (error "blob-unpad: Argument must be a blob")) … … 139 187 out))) 140 188 141 (define (make-cbc-encryptor encryptor blocksize) 142 (letrec ((encrypt (lambda (input inoffset inputsize iv output outoffset) 143 (cond 144 ((= inoffset inputsize) ; Zero bytes 145 (let* ((inblock (blob-pad *the-null-blob* blocksize)) 146 (outblock (encryptor (blob-xor iv inblock)))) 147 (move-memory! outblock output blocksize 0 outoffset) 148 output)) ; Terminate 149 ((<= (+ inoffset blocksize) inputsize) ; Just another block 150 (let* ((inblock (subblob input inoffset blocksize)) 151 (outblock (encryptor (blob-xor iv inblock)))) 152 153 (move-memory! outblock output blocksize 0 outoffset) 154 (encrypt input (+ inoffset blocksize) inputsize outblock output (+ outoffset blocksize)))) ; Recurse 155 (else ; Partial block 156 (let* ((inblock (blob-pad 157 (subblob input inoffset (- inputsize inoffset)) 158 blocksize)) 159 (outblock (encryptor (blob-xor iv inblock)))) 160 161 (move-memory! outblock output blocksize 0 outoffset) 162 output)))))) ; Terminate 163 164 (lambda (input iv) 165 (let* ((inputsize (blob-size input)) 166 (output-whole-blocks (quotient inputsize blocksize)) 167 (output-overflow (remainder inputsize blocksize)) 168 (outputsize (if (zero? output-overflow) 169 (+ inputsize blocksize) 170 (* (+ 1 output-whole-blocks) blocksize))) 171 (output (make-blob outputsize))) 172 (encrypt input 0 inputsize iv output 0))))) 173 174 (define (make-cbc-decryptor decryptor blocksize) 175 (letrec ((decrypt (lambda (input inoffset inputsize iv output outoffset) 176 (if (= (+ inoffset blocksize) inputsize) 177 ; Last block 178 (let* ((inblock (subblob input inoffset blocksize)) 179 (outblock 180 (blob-unpad 181 (blob-xor iv 182 (decryptor inblock))))) 183 (move-memory! outblock output (blob-size outblock) 0 outoffset) 184 (subblob output 0 (+ outoffset (blob-size outblock)))) ; Terminate 185 ; Not last block 186 (let* ((inblock (subblob input inoffset blocksize)) 187 (outblock 188 (blob-xor iv 189 (decryptor inblock)))) 190 191 (move-memory! outblock output blocksize 0 outoffset) 192 (decrypt input (+ inoffset blocksize) inputsize inblock output (+ outoffset blocksize))))))) ; Recurse 193 194 (lambda (input iv) 195 (let* ((inputsize (blob-size input)) 196 (output (make-blob inputsize))) 197 (decrypt input 0 inputsize iv output 0))))) 189 ;holds the state of the counter needed for ctr-mode. On every invocation of the resulting 190 ;function the value of the counter will be increased by one.On completion it should wrap around. 191 (define (make-next-ctr iv bsize) 192 (let ((cnt iv) 193 (incblob (foreign-lambda* void ((blob in) (blob out) (int blocksize)) " 194 unsigned char cur; 195 int block; 196 memmove(out,in,blocksize); 197 for(block=blocksize-1;block>=0;block--) { 198 cur = in[block]; 199 if (cur >= 0xFF) { 200 out[block] = 0; 201 continue; 202 } 203 out[block] = cur+1; 204 break; 205 } 206 "))) 207 (lambda () 208 (let* ((ocnt cnt) 209 (ncnt (make-blob bsize))) 210 (incblob ocnt ncnt bsize) 211 (set! cnt ncnt) 212 ocnt)))) 213 214 ;internal ctr-encrypt function used by the make- variants 215 ;on each block fetches the current counter state (which increases the counter) 216 ;encrypts it and xor as much blob as it has available. 217 (define (ctr-encrypt input inoffset inputsize nextfn output outoffset encryptor blocksize) 218 (cond 219 ((= inoffset inputsize) output) ; we just output what we have. 220 ((<= (+ inoffset blocksize) inputsize) ; Just another block 221 (let* ((inblock (subblob input inoffset blocksize)) 222 (outblock (blob-xor inblock (encryptor (nextfn))))) 223 (move-memory! outblock output blocksize 0 outoffset) 224 (ctr-encrypt input (+ inoffset blocksize) inputsize nextfn output (+ outoffset blocksize) encryptor blocksize))) ; Recurse 225 (else ; Partial block 226 (let* ((inblock (subblob input inoffset (- inputsize inoffset))) 227 (outblock (blob-xor inblock (encryptor (nextfn))))) 228 (move-memory! outblock output (blob-size outblock) 0 outoffset) 229 output)))) 230 231 ;creates a ctr encryptor that needs an iv and input blob 232 (define (make-ctr-encryptor encryptor blocksize) 233 (lambda (input iv) 234 (let* ((inputsize (blob-size input)) 235 (outputsize inputsize) ;ct size since no iv and no padding. 236 (output (make-blob outputsize)) 237 (nextf (make-next-ctr iv blocksize))) 238 (ctr-encrypt input 0 inputsize nextf output 0 encryptor blocksize)))) 239 240 ;creates a ctr encryptor function that needs an iv and input blob but 241 ;stores the IV in the first output block (unencrypted since ctr iv is only a counter) 242 (define (make-ctr*-encryptor encryptor blocksize) 243 (lambda (input iv) 244 (let* ((inputsize (blob-size input)) 245 (outputsize (+ inputsize blocksize)) ;iv + ct cause ctr doesn't need padding. 246 (output (make-blob outputsize)) 247 (nextf (make-next-ctr iv blocksize))) 248 (move-memory! iv output blocksize) 249 (ctr-encrypt input 0 inputsize nextf output blocksize encryptor blocksize)))) 250 251 ;internal ctr-decrypt function used by the make- variants 252 ;gets the current state of the counter (which increases the counter) and then 253 ;*encrypts* the counter and xors that with as much blob as it has. 254 (define (ctr-decrypt input inoffset inputsize nextfn output outoffset encryptor blocksize) 255 (if (> (+ inoffset blocksize) inputsize) 256 ; Last block 257 (let* ((inblock (subblob input inoffset (- (blob-size input) inoffset))) 258 (outblock 259 (blob-xor inblock 260 (encryptor (nextfn))))) 261 (move-memory! outblock output (blob-size outblock) 0 outoffset) 262 (subblob output 0 (+ outoffset (- (blob-size input) inoffset)))) ; Terminate 263 ; More blocks following 264 (let* ((inblock (subblob input inoffset blocksize)) 265 (outblock 266 (blob-xor inblock 267 (encryptor (nextfn))))) 268 (move-memory! outblock output blocksize 0 outoffset) 269 (ctr-decrypt input (+ inoffset blocksize) inputsize nextfn output (+ outoffset blocksize) encryptor blocksize)))) ; Recurse 270 271 ;returns a function that requires an input and an iv. it starts decrypting from the first blob. 272 ;typically ctr mode decryption requires an *encryptor* 273 (define (make-ctr-decryptor encryptor blocksize) 274 (lambda (input iv) 275 (let* ((inputsize (blob-size input)) 276 (output (make-blob inputsize)) 277 (nextf (make-next-ctr iv blocksize))) 278 (ctr-decrypt input 0 inputsize nextf output 0 encryptor blocksize)))) 279 280 ;returns a function that requires an input. it reads the unencrypted iv from the first block 281 ;and then uses that to start decrypting in ctr mode the blob that follows. 282 ;typically ctr mode decryption requires an *encryptor* 283 (define (make-ctr*-decryptor encryptor blocksize) 284 (lambda (input) 285 (let* ((inputsize (blob-size input)) 286 (output (make-blob inputsize)) 287 (iv (subblob input 0 blocksize)) 288 (nextf (make-next-ctr iv blocksize))) 289 (ctr-decrypt input blocksize inputsize nextf output 0 encryptor blocksize)))) 290 291 ;internal cbc encrypt function used by the make- variants. cbc tradionally requires padding 292 (define (cbc-encrypt input inoffset inputsize iv output outoffset padfn encryptor blocksize) 293 (cond 294 ((= inoffset inputsize) ; Zero bytes 295 (let* ((inblock (padfn *the-null-blob* blocksize)) 296 (outblock (encryptor (blob-xor iv inblock)))) 297 (move-memory! outblock output blocksize 0 outoffset) 298 output)) ; Terminate 299 ((<= (+ inoffset blocksize) inputsize) ; Just another block 300 (let* ((inblock (subblob input inoffset blocksize)) 301 (outblock (encryptor (blob-xor iv inblock)))) 302 (move-memory! outblock output blocksize 0 outoffset) 303 (cbc-encrypt input (+ inoffset blocksize) inputsize outblock output (+ outoffset blocksize) padfn encryptor blocksize))) ; Recurse 304 (else ; Partial block 305 (let* ((inblock (padfn 306 (subblob input inoffset (- inputsize inoffset)) 307 blocksize)) 308 (outblock (encryptor (blob-xor iv inblock)))) 309 (move-memory! outblock output blocksize 0 outoffset) 310 output)))) ; Terminate 311 312 ;creates a cbs encryptor function that requires an input and an iv in order to start the 313 ;cbc decryption from the first blob. In the make arguments a padding function like pkcs5 or pad-blob is needed. 314 (define (make-cbc-encryptor encryptor padfn blocksize) 315 (lambda (input iv) 316 (let* ((inputsize (blob-size input)) 317 (output-whole-blocks (quotient inputsize blocksize)) 318 (output-overflow (remainder inputsize blocksize)) 319 (outputsize (if (zero? output-overflow) 320 (+ inputsize blocksize) 321 (* (+ 1 output-whole-blocks) blocksize))) 322 (output (make-blob outputsize))) 323 (cbc-encrypt input 0 inputsize iv output 0 padfn encryptor blocksize)))) 198 324 199 325 ; As above, but the encryptor stores the IV in the output block (encrypted)... 200 201 (define (make-cbc*-encryptor encryptor blocksize) 202 (letrec ((encrypt (lambda (input inoffset inputsize iv output outoffset) 203 (cond 204 ((= inoffset inputsize) ; Zero bytes 205 (let* ((inblock (blob-pad *the-null-blob* blocksize)) 206 (outblock (encryptor (blob-xor iv inblock)))) 207 (move-memory! outblock output blocksize 0 outoffset) 208 output)) ; Terminate 209 ((<= (+ inoffset blocksize) inputsize) ; Just another block 210 (let* ((inblock (subblob input inoffset blocksize)) 211 (outblock (encryptor (blob-xor iv inblock)))) 212 213 (move-memory! outblock output blocksize 0 outoffset) 214 (encrypt input (+ inoffset blocksize) inputsize outblock output (+ outoffset blocksize)))) ; Recurse 215 (else ; Partial block 216 (let* ((inblock (blob-pad 217 (subblob input inoffset (- inputsize inoffset)) 218 blocksize)) 219 (outblock (encryptor (blob-xor iv inblock)))) 220 221 (move-memory! outblock output blocksize 0 outoffset) 222 output)))))) ; Terminate 223 224 (lambda (input iv) 225 (let* ((inputsize (blob-size input)) 226 (output-whole-blocks (quotient inputsize blocksize)) 227 (output-overflow (remainder inputsize blocksize)) 228 (outputsize (if (zero? output-overflow) ; Round up to block size, plus an extra block for the IV 229 (+ inputsize blocksize blocksize) 230 (* (+ 2 output-whole-blocks) blocksize))) 231 (output (make-blob outputsize)) 232 (encrypted-iv (encryptor iv))) 233 (move-memory! encrypted-iv output blocksize) 234 (encrypt input 0 inputsize iv output blocksize))))) 235 236 ;... and the decryptor retreives it. 237 238 (define (make-cbc*-decryptor decryptor blocksize) 239 (letrec ((decrypt (lambda (input inoffset inputsize iv output outoffset) 240 (if (= (+ inoffset blocksize) inputsize) 241 ; Last block 242 (let* ((inblock (subblob input inoffset blocksize)) 243 (outblock 244 (blob-unpad 245 (blob-xor iv 246 (decryptor inblock))))) 247 (move-memory! outblock output (blob-size outblock) 0 outoffset) 248 (subblob output 0 (+ outoffset (blob-size outblock)))) ; Terminate 249 ; Not last block 250 (let* ((inblock (subblob input inoffset blocksize)) 251 (outblock 252 (blob-xor iv 253 (decryptor inblock)))) 254 255 (move-memory! outblock output blocksize 0 outoffset) 256 (decrypt input (+ inoffset blocksize) inputsize inblock output (+ outoffset blocksize))))))) ; Recurse 257 258 (lambda (input) 259 (let* ((inputsize (blob-size input)) 260 (output (make-blob inputsize)) 261 (iv (decryptor (subblob input 0 blocksize)))) 262 (decrypt input blocksize inputsize iv output 0))))) ) 326 (define (make-cbc*-encryptor encryptor padfn blocksize) 327 (lambda (input iv) 328 (let* ((inputsize (blob-size input)) 329 (output-whole-blocks (quotient inputsize blocksize)) 330 (output-overflow (remainder inputsize blocksize)) 331 (outputsize (if (zero? output-overflow) ; Round up to block size, plus an extra block for the IV 332 (+ inputsize blocksize blocksize) 333 (* (+ 2 output-whole-blocks) blocksize))) 334 (output (make-blob outputsize)) 335 (encrypted-iv (encryptor iv))) 336 (move-memory! encrypted-iv output blocksize) 337 (cbc-encrypt input 0 inputsize iv output blocksize padfn encryptor blocksize)))) 338 339 ;internal cbc-decrypt function used by the make- variants. an unpad function is needed. 340 (define (cbc-decrypt input inoffset inputsize iv output outoffset unpadfn decryptor blocksize) 341 (if (= (+ inoffset blocksize) inputsize) 342 ; Last block 343 (let* ((inblock (subblob input inoffset blocksize)) 344 (outblock 345 (unpadfn 346 (blob-xor iv 347 (decryptor inblock))))) 348 (move-memory! outblock output (blob-size outblock) 0 outoffset) 349 (subblob output 0 (+ outoffset (blob-size outblock)))) ; Terminate 350 ; Not last block 351 (let* ((inblock (subblob input inoffset blocksize)) 352 (outblock 353 (blob-xor iv 354 (decryptor inblock)))) 355 (move-memory! outblock output blocksize 0 outoffset) 356 (cbc-decrypt input (+ inoffset blocksize) inputsize inblock output (+ outoffset blocksize) unpadfn decryptor blocksize)))) ; Recurse 357 358 ;creates a cbc decryptor that uses and iv to start decrypting from the first byte of the input blob. 359 ;an unpad function is needed in cbc mode decryption. 360 (define (make-cbc-decryptor decryptor unpadfn blocksize) 361 (lambda (input iv) 362 (let* ((inputsize (blob-size input)) 363 (output (make-blob inputsize))) 364 (cbc-decrypt input 0 inputsize iv output 0 unpadfn decryptor blocksize)))) 365 366 ;same as above but treats the first block of the input as the encrypted IV. 367 (define (make-cbc*-decryptor decryptor unpadfn blocksize) 368 (lambda (input) 369 (let* ((inputsize (blob-size input)) 370 (output (make-blob inputsize)) 371 (iv (decryptor (subblob input 0 blocksize)))) 372 (cbc-decrypt input blocksize inputsize iv output 0 unpadfn decryptor blocksize)))) ) -
release/5/crypto-tools/trunk/tests/run.scm
r36348 r38658 1 (import crypto-tools) 1 2 (import (chicken format)) 2 3 (import (chicken blob)) 3 (import crypto-tools)4 4 5 5 (define hexstring1 (blob->hexstring (hexstring->blob "0123456789ABCDEF"))) 6 ( printf"Hex1: ~A\n" hexstring1)6 (format #t "Hex1: ~A\n" hexstring1) 7 7 (assert (string=? hexstring1 "0123456789abcdef")) 8 8 9 9 (define hexstring2 (blob->hexstring/uppercase (hexstring->blob "0123456789ABCDEF"))) 10 ( printf"Hex2: ~A\n" hexstring2)10 (format #t "Hex2: ~A\n" hexstring2) 11 11 (assert (string=? hexstring2 "0123456789ABCDEF")) 12 12 13 13 (define hexstring3 (blob->hexstring (hexstring->blob ""))) 14 ( printf"Hex3: ~A\n" hexstring3)14 (format #t "Hex3: ~A\n" hexstring3) 15 15 (assert (string=? hexstring3 "")) 16 16 … … 20 20 (padded (blob-pad input-blob 16))) 21 21 22 ( printf"Test vector ~Aa: ~A\n" name (blob->hexstring padded))22 (format #t "Test vector ~Aa: ~A\n" name (blob->hexstring padded)) 23 23 (let ((unpadded (blob-unpad padded))) 24 24 25 ( printf"Test vector ~Ab: <~A>\n" name (blob->string unpadded))25 (format #t "Test vector ~Ab: <~A>\n" name (blob->string unpadded)) 26 26 27 27 (assert (blob=? input-blob unpadded))))) … … 40 40 ((encryptor dummy-encryptor) 41 41 (decryptor dummy-decryptor) 42 (cbc-encryptor (make-cbc-encryptor encryptor 16))43 (cbc-decryptor (make-cbc-decryptor decryptor 16))42 (cbc-encryptor (make-cbc-encryptor encryptor blob-pad 16)) 43 (cbc-decryptor (make-cbc-decryptor decryptor blob-unpad 16)) 44 44 (test-input (string->blob string)) 45 45 (encrypted (cbc-encryptor test-input (hexstring->blob "00010203050607080A0B0C0D0F101112"))) 46 46 (decrypted (cbc-decryptor encrypted (hexstring->blob "00010203050607080A0B0C0D0F101112")))) 47 47 48 ( printf"Test vector ~Aa: ~A\n" name (blob->hexstring/uppercase encrypted))49 ( printf"Test vector ~Ab: <~A>\n" name (blob->string decrypted))48 (format #t "Test vector ~Aa: ~A\n" name (blob->hexstring/uppercase encrypted)) 49 (format #t "Test vector ~Ab: <~A>\n" name (blob->string decrypted)) 50 50 (assert (blob=? test-input decrypted)))) 51 51 … … 63 63 ((encryptor dummy-encryptor) 64 64 (decryptor dummy-decryptor) 65 (cbc-encryptor (make-cbc*-encryptor encryptor 16))66 (cbc-decryptor (make-cbc*-decryptor decryptor 16))65 (cbc-encryptor (make-cbc*-encryptor encryptor blob-pad 16)) 66 (cbc-decryptor (make-cbc*-decryptor decryptor blob-unpad 16)) 67 67 (test-input (string->blob string)) 68 68 (encrypted (cbc-encryptor test-input (hexstring->blob "00010203050607080A0B0C0D0F101112"))) 69 69 (decrypted (cbc-decryptor encrypted))) 70 70 71 ( printf"Test vector ~Aa: ~A\n" name (blob->hexstring/uppercase encrypted))72 ( printf"Test vector ~Ab: <~A>\n" name (blob->string decrypted))71 (format #t "Test vector ~Aa: ~A\n" name (blob->hexstring/uppercase encrypted)) 72 (format #t "Test vector ~Ab: <~A>\n" name (blob->string decrypted)) 73 73 (assert (blob=? test-input decrypted)))) 74 74 … … 82 82 (test-cbc* "20" "1234567890123456123456789012345") ; 2 blocks - 1 83 83 84 (define (test-ctr name string) 85 (let* 86 ((encryptor dummy-encryptor) 87 (decryptor dummy-decryptor) 88 (ctr-encryptor (make-ctr-encryptor encryptor 16)) 89 (ctr-decryptor (make-ctr-decryptor decryptor 16)) 90 (test-input (string->blob string)) 91 (iv (hexstring->blob "00010203050607080A0B0C0D0F101112")) 92 (encrypted (ctr-encryptor test-input iv)) 93 (decrypted (ctr-decryptor encrypted iv))) 94 95 (format #t "Test vector ~Aa: ~A\n" name (blob->hexstring/uppercase encrypted)) 96 (format #t "Test vector ~Ab: <~A>\n" name (blob->string decrypted)) 97 (assert (blob=? test-input decrypted)))) 98 99 (test-ctr "21" "") ; Zero bytes 100 (test-ctr "22" "a") ; One byte 101 (test-ctr "23" "1234567890123456") ; 1 block exactly 102 (test-ctr "24" "12345678901234561234567890123456") ; 2 blocks exactly 103 (test-ctr "25" "1234567890123456X") ; 1 block + 1 104 (test-ctr "26" "12345678901234561234567890123456X") ; 2 blocks + 1 105 (test-ctr "27" "123456789012345") ; 1 block - 1 106 (test-ctr "28" "1234567890123456123456789012345") ; 2 blocks - 1 107 108 109 (define (test-ctr* name string) 110 (let* 111 ((encryptor dummy-encryptor) 112 (decryptor dummy-decryptor) 113 (ctr-encryptor (make-ctr*-encryptor encryptor 16)) 114 (ctr-decryptor (make-ctr*-decryptor decryptor 16)) 115 (test-input (string->blob string)) 116 (encrypted (ctr-encryptor test-input (hexstring->blob "00010203050607080A0B0C0D0F101112"))) 117 (decrypted (ctr-decryptor encrypted))) 118 119 (format #t "Test vector ~Aa: ~A\n" name (blob->hexstring/uppercase encrypted)) 120 (format #t "Test vector ~Ab: <~A>\n" name (blob->string decrypted)) 121 (assert (blob=? test-input decrypted)))) 122 123 (test-ctr* "29" "") ; Zero bytes 124 (test-ctr* "30" "a") ; One byte 125 (test-ctr* "31" "1234567890123456") ; 1 block exactly 126 (test-ctr* "32" "12345678901234561234567890123456") ; 2 blocks exactly 127 (test-ctr* "33" "1234567890123456X") ; 1 block + 1 128 (test-ctr* "34" "12345678901234561234567890123456X") ; 2 blocks + 1 129 (test-ctr* "35" "123456789012345") ; 1 block - 1 130 (test-ctr* "36" "1234567890123456123456789012345") ; 2 blocks - 1 131 132
Note: See TracChangeset
for help on using the changeset viewer.