Changeset 38658 in project for release


Ignore:
Timestamp:
04/27/20 21:14:13 (3 months ago)
Author:
Alaric Snell-Pym
Message:

Applied patch from dsp (against original c4 version)

Location:
release/5/crypto-tools/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/crypto-tools/trunk/crypto-tools.egg

    r36348 r38658  
    11((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  
    11(module crypto-tools
    22(blob->hexstring blob->hexstring/uppercase hexstring->blob
    3  blob-xor blob-pad blob-unpad
    4  make-cbc-encryptor make-cbc-decryptor
    5  make-cbc*-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)
    66
    77(import scheme)
    88(import (chicken foreign))
     9(import (chicken blob))
    910(import (chicken base))
    10 (import (chicken blob))
    1111(import (chicken format))
     12(import (chicken locative))
    1213(import (chicken memory))
    13 (import (chicken locative))
    14 
     14
     15;zero sizes blob
    1516(define *the-null-blob* (make-blob 0))
    1617
     18;ensures the input is a blob of certain size
    1719(define (check-blob blob len function)
    1820   (if (blob? blob)
     
    2224      (error (sprintf "~A: Input was not a blob" function))))
    2325
     26;allocates a new string where every byte of the blob is encoded as a two char hex number
    2427(define (blob->hexstring blob)
    2528   (if (zero? (blob-size blob))
     
    3538         str)))
    3639
     40;same as blob->hexstring but with uppercase hex chars
    3741(define (blob->hexstring/uppercase blob)
    3842   (if (zero? (blob-size blob))
     
    4852         str)))
    4953
     54;converts a hex encoded string of two chars per byte to a blob
    5055(define (hexstring->blob string)
    5156   (let ((len (string-length string)))
     
    7984                  blob))))))
    8085
     86;makes a new blob and copies in it part of the contents of the original
    8187(define (subblob blob offset length)
    8288   (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.
    95102(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)))
    100109      ((foreign-lambda* void ((int len) (blob a) (blob b) (blob out)) "
    101110         while (len--) {
    102111            (*out++) = (*a++) ^ (*b++);
    103112         }
    104       ") (blob-size a) a b out)
     113      ") minlen a b out)
    105114      out))
    106115
     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.
    107155(define (blob-pad in len)
    108156   (if (not (blob? in)) (error "blob-pad: Argument must be a blob"))
    109157   (if (>= (blob-size in) len) (error "blob-pad: Argument must be smaller than the block size"))
    110    
    111158   (let ((out (make-blob len))
    112159         (inlen (blob-size in)))
     
    120167      out))
    121168
     169;unpads by removing 0x00 until it discovers a 0x80 byte
    122170(define (blob-unpad in)
    123171   (if (not (blob? in)) (error "blob-unpad: Argument must be a blob"))
     
    139187            out)))
    140188
    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))))
    198324
    199325; 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)
    12(import (chicken format))
    23(import (chicken blob))
    3 (import crypto-tools)
    44
    55(define hexstring1 (blob->hexstring (hexstring->blob "0123456789ABCDEF")))
    6 (printf "Hex1: ~A\n" hexstring1)
     6(format #t "Hex1: ~A\n" hexstring1)
    77(assert (string=? hexstring1 "0123456789abcdef"))
    88
    99(define hexstring2 (blob->hexstring/uppercase (hexstring->blob "0123456789ABCDEF")))
    10 (printf "Hex2: ~A\n" hexstring2)
     10(format #t "Hex2: ~A\n" hexstring2)
    1111(assert (string=? hexstring2 "0123456789ABCDEF"))
    1212
    1313(define hexstring3 (blob->hexstring (hexstring->blob "")))
    14 (printf "Hex3: ~A\n" hexstring3)
     14(format #t "Hex3: ~A\n" hexstring3)
    1515(assert (string=? hexstring3 ""))
    1616
     
    2020       (padded (blob-pad input-blob 16)))
    2121       
    22       (printf "Test vector ~Aa: ~A\n" name (blob->hexstring padded))
     22      (format #t "Test vector ~Aa: ~A\n" name (blob->hexstring padded))
    2323      (let ((unpadded (blob-unpad padded)))
    2424
    25          (printf "Test vector ~Ab: <~A>\n" name (blob->string unpadded))
     25         (format #t "Test vector ~Ab: <~A>\n" name (blob->string unpadded))
    2626     
    2727         (assert (blob=? input-blob unpadded)))))
     
    4040      ((encryptor dummy-encryptor)
    4141       (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))
    4444       (test-input (string->blob string))
    4545       (encrypted (cbc-encryptor test-input (hexstring->blob "00010203050607080A0B0C0D0F101112")))
    4646       (decrypted (cbc-decryptor encrypted (hexstring->blob "00010203050607080A0B0C0D0F101112"))))
    4747   
    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))
    5050      (assert (blob=? test-input decrypted))))
    5151
     
    6363      ((encryptor dummy-encryptor)
    6464       (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))
    6767       (test-input (string->blob string))
    6868       (encrypted (cbc-encryptor test-input (hexstring->blob "00010203050607080A0B0C0D0F101112")))
    6969       (decrypted (cbc-decryptor encrypted)))
    7070   
    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))
    7373      (assert (blob=? test-input decrypted))))
    7474
     
    8282(test-cbc* "20" "1234567890123456123456789012345") ; 2 blocks - 1
    8383
     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.