Changeset 40245 in project


Ignore:
Timestamp:
07/01/21 21:34:21 (4 weeks ago)
Author:
Vasilij Schneidermann
Message:

openssl: Implement AEAD ciphers

Location:
release/5/openssl/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/openssl/trunk/openssl.cipher.scm

    r40228 r40245  
    1616   cipher-context-update!
    1717   cipher-context-final!
     18   cipher-context-get-tag
    1819   string-cipher
     20   string-encrypt-and-digest
     21   string-decrypt-and-verify
    1922   file-cipher
    2023   open-cipher-port
     
    2326(import scheme)
    2427(import (chicken base))
     28(import (chicken bitwise))
    2529(import (chicken blob))
    2630(import (chicken condition))
     
    4448
    4549(define OBJ_NAME_ALIAS (foreign-value "OBJ_NAME_ALIAS" int))
     50(define EVP_CIPH_FLAG_AEAD_CIPHER (foreign-value "EVP_CIPH_FLAG_AEAD_CIPHER" int))
     51(define EVP_CIPH_CCM_MODE (foreign-value "EVP_CIPH_CCM_MODE" int))
     52(define EVP_CTRL_AEAD_SET_IVLEN (foreign-value "EVP_CTRL_AEAD_SET_IVLEN" int))
     53(define EVP_CTRL_AEAD_SET_TAG (foreign-value "EVP_CTRL_AEAD_SET_TAG" int))
     54(define EVP_CTRL_AEAD_GET_TAG (foreign-value "EVP_CTRL_AEAD_GET_TAG" int))
     55(define EVP_CTRL_CCM_SET_MSGLEN (foreign-value "EVP_CTRL_CCM_SET_MSGLEN" int))
     56
    4657(define-foreign-type OBJ_NAME* (const (c-pointer (struct "obj_name_st"))))
    4758(define-foreign-type EVP_CIPHER* (const c-pointer))
     
    5263(define-external (EVP_CipherList_callback (OBJ_NAME* obj) (c-pointer _arg)) c-pointer
    5364  (let ((name ((foreign-lambda* c-string ((OBJ_NAME* obj)) "C_return(obj->name);") obj))
    54         (alias ((foreign-lambda* int ((OBJ_NAME* obj)) "C_return(obj->alias);") obj))
    55 )
     65        (alias ((foreign-lambda* int ((OBJ_NAME* obj)) "C_return(obj->alias);") obj)))
    5666    (when (not (= alias OBJ_NAME_ALIAS))
    5767      (set! evp-ciphers (cons name evp-ciphers)))
     
    6676(define EVP_CIPHER_CTX_iv_length (foreign-lambda int "EVP_CIPHER_CTX_iv_length" EVP_CIPHER_CTX*))
    6777(define EVP_CIPHER_CTX_ctrl (foreign-lambda int "EVP_CIPHER_CTX_ctrl" EVP_CIPHER_CTX* int int blob))
     78(define EVP_CIPHER_CTX_flags (foreign-lambda int "EVP_CIPHER_CTX_flags" EVP_CIPHER_CTX*))
    6879
    6980(define EVP_CipherInit_ex (foreign-lambda bool "EVP_CipherInit_ex" EVP_CIPHER_CTX* EVP_CIPHER* c-pointer blob blob int))
     
    126137(define max-block-length EVP_MAX_BLOCK_LENGTH)
    127138
    128 (define-record cipher-context ptr)
     139(define-record cipher-context ptr tag-length)
    129140
    130141(define (cipher-context-free! context)
     
    138149    (when (not ctx)
    139150      (openssl-error 'cipher-context-allocate!))
    140     (set-finalizer! (make-cipher-context ctx) cipher-context-free!)))
     151    (set-finalizer! (make-cipher-context ctx #f) cipher-context-free!)))
    141152
    142153(define (cipher-context-reset! context)
     
    147158    (void)))
    148159
    149 (define cipher/encrypt 1)
    150 (define cipher/decrypt 0)
    151 
    152 ;; TODO: effective-iv-length
    153 ;; TODO: auth-data
    154 ;; TODO: tag-length
    155 ;; TODO: message-length
     160(define (aead-cipher? ctx)
     161  (bitwise-and (EVP_CIPHER_CTX_flags ctx) EVP_CIPH_FLAG_AEAD_CIPHER))
     162
    156163(define (cipher-context-init! context cipher key iv #!key
    157164                              (mode 'encrypt)
    158165                              (padding #t)
    159                               (effective-key-length #f))
     166                              (effective-key-length #f)
     167                              (auth-data #f)
     168                              (tag-length #f)
     169                              (expected-tag #f)
     170                              (effective-iv-length #f)
     171                              (message-length #f))
    160172  (define (mode->flag mode)
    161173    (case mode
     
    163175      ((decrypt) 0)
    164176      (else (openssl-type-error 'cipher-context-init! "mode symbol" (list mode)))))
     177  (define (ccm-cipher? ctx)
     178    (bitwise-and (EVP_CIPHER_CTX_flags ctx) EVP_CIPH_CCM_MODE))
    165179  (and-let* ((ctx (cipher-context-ptr context)))
    166180    (ERR_clear_error)
     
    175189      (when (and iv-length (not (<= (EVP_CIPHER_CTX_iv_length ctx) iv-length)))
    176190        (openssl-type-error 'cipher-context-init! "sufficient iv length" iv-length))
     191      (when effective-iv-length
     192        (when (not (aead-cipher? ctx))
     193          (openssl-type-error 'cipher-context-init! "AEAD cipher" (cipher-name cipher)))
     194        (when (> effective-iv-length max-iv-length)
     195          (openssl-type-error 'cipher-context-init! "integer <= 16" effective-iv-length))
     196        (when (not (EVP_CIPHER_CTX_ctrl ctx EVP_CTRL_AEAD_SET_IVLEN effective-iv-length #f))
     197          (openssl-error 'cipher-context-init! (list effective-iv-length))))
     198      (when (and expected-tag tag-length)
     199        (when (not (aead-cipher? ctx))
     200          (openssl-type-error 'cipher-context-init! "AEAD cipher" (cipher-name cipher)))
     201        (when (not (eqv? mode 'decrypt))
     202          (openssl-type-error 'cipher-context-init! "decrypt mode" mode))
     203        (when (not tag-length)
     204          (openssl-type-error 'cipher-context-init! "tag length"))
     205        (when (> tag-length (blob-size expected-tag))
     206          (openssl-type-error 'cipher-context-init! "tag shorter than tag length"))
     207        (when (not (EVP_CIPHER_CTX_ctrl ctx EVP_CTRL_AEAD_SET_TAG tag-length expected-tag))
     208          (openssl-error 'cipher-context-init! (list expected-tag tag-length))))
     209      (when (and (not expected-tag) tag-length)
     210        (when (not (aead-cipher? ctx))
     211          (openssl-type-error 'cipher-context-init! "AEAD cipher" (cipher-name cipher)))
     212        (when (not (eqv? mode 'encrypt))
     213          (openssl-type-error 'cipher-context-init! "encrypt mode" mode))
     214        (when (> tag-length max-iv-length)
     215          (openssl-type-error 'cipher-context-init! "integer <= 16" tag-length))
     216        (when (not (EVP_CIPHER_CTX_ctrl ctx EVP_CTRL_AEAD_SET_TAG tag-length #f))
     217          (openssl-error 'cipher-context-init! (list tag-length)))
     218        (cipher-context-tag-length-set! context tag-length))
    177219      (when (not (EVP_CipherInit_ex ctx #f #f key iv -1))
    178220        (openssl-error 'cipher-context-init! (list cipher key iv)))
     221      (when message-length
     222        (when (not (ccm-cipher? ctx))
     223          (openssl-type-error 'cipher-context-init! "CCM cipher mode" (cipher-name cipher)))
     224        ;; https://github.com/pyca/cryptography/blob/0034926f2cca02258f50e9faccb90ec344790159/src/cryptography/hazmat/backends/openssl/aead.py#L108
     225        ;; https://github.com/pyca/cryptography/blob/0034926f2cca02258f50e9faccb90ec344790159/src/cryptography/hazmat/backends/openssl/aead.py#L77
     226        (let-location ((_length int))
     227          (when (not (EVP_CipherUpdate ctx #f (location _length) #f message-length))
     228            (openssl-error 'cipher-context-init! (list message-length)))))
     229      (when auth-data
     230        (when (not (aead-cipher? ctx))
     231          (openssl-type-error 'cipher-context-init! "AEAD cipher" (cipher-name cipher)))
     232        (let-location ((_length int))
     233          (when (not (EVP_CipherUpdate ctx #f (location _length) auth-data (blob-size auth-data)))
     234            (openssl-error 'cipher-context-init! (list auth-data (blob-size auth-data))))))
    179235      (EVP_CIPHER_CTX_set_padding ctx padding)
    180236      (void))))
     
    202258        ret))))
    203259
     260(define (cipher-context-get-tag context)
     261  (and-let* ((ctx (cipher-context-ptr context)))
     262    (ERR_clear_error)
     263    (when (not (aead-cipher? ctx))
     264      (openssl-type-error 'cipher-context-get-tag "AEAD cipher"))
     265    (let* ((tag-length (cipher-context-tag-length context))
     266           (buf (make-blob tag-length)))
     267      (when (not tag-length)
     268        (openssl-type-error 'cipher-context-get-tag "tag length to be set"))
     269      (when (not (EVP_CIPHER_CTX_ctrl ctx EVP_CTRL_AEAD_GET_TAG tag-length buf))
     270        (openssl-error 'cipher-context-get-tag tag-length))
     271      buf)))
     272
    204273(define (string-cipher cipher str key iv #!rest options)
    205274  (let ((context (cipher-context-allocate!)))
    206275    (apply cipher-context-init! context cipher key iv options)
    207276    (let* ((output (cipher-context-update! context (string->blob str)))
    208            (final (cipher-context-final! context)))
     277           (final (cipher-context-final! context))
     278           (output (string-append (blob->string output) (blob->string final))))
    209279      (cipher-context-free! context)
    210       (string-append (blob->string output) (blob->string final)))))
     280      output)))
     281
     282(define (string-encrypt-and-digest cipher str key iv #!rest options)
     283  (let ((context (cipher-context-allocate!)))
     284    (apply cipher-context-init! context cipher key iv mode: 'encrypt options)
     285    (let* ((output (cipher-context-update! context (string->blob str)))
     286           (final (cipher-context-final! context))
     287           (output (string-append (blob->string output) (blob->string final)))
     288           (tag (blob->string (cipher-context-get-tag context))))
     289      (cipher-context-free! context)
     290      (values output tag))))
     291
     292(define (string-decrypt-and-verify cipher str tag key iv #!rest options)
     293  (let ((context (cipher-context-allocate!)))
     294    (apply cipher-context-init! context cipher key iv
     295           mode: 'decrypt
     296           tag-length: (string-length tag)
     297           expected-tag: (string->blob tag)
     298           options)
     299    (let* ((output (cipher-context-update! context (string->blob str)))
     300           (final (cipher-context-final! context))
     301           (output (string-append (blob->string output) (blob->string final))))
     302      (cipher-context-free! context)
     303      output)))
    211304
    212305(define (file-cipher cipher in-path out-path key iv #!rest options)
  • release/5/openssl/trunk/tests/cipher-test.scm

    r40228 r40245  
    9595    (test "AES-128-CTR test vector (encryption)" ciphertext (encrypt-string aes-128-ctr plaintext key iv))
    9696    (test "AES-128-CTR test vector (decryption)" plaintext (decrypt-string aes-128-ctr ciphertext key iv))))
     97
     98(when aes-128-gcm
     99  (let ((key (string->blob "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"))
     100        (iv (string->blob "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00")))
     101    (let ((plaintext ""))
     102      (receive (ciphertext tag)
     103          (string-encrypt-and-digest aes-128-gcm plaintext key iv tag-length: 16)
     104        (test "AES-GCM test vector (encryption)" "" ciphertext)
     105        (test "AES-GCM test vector (tag)" "\x58\xe2\xfc\xce\xfa\x7e\x30\x61\x36\x7f\x1d\x57\xa4\xe7\x45\x5a" tag)
     106        (test "AES-GCM test vector (decryption)" plaintext
     107              (string-decrypt-and-verify aes-128-gcm ciphertext tag key iv))))
     108    (let ((plaintext "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"))
     109      (receive (ciphertext tag)
     110          (string-encrypt-and-digest aes-128-gcm plaintext key iv tag-length: 16)
     111        (test "AES-GCM test vector (encryption)" "\x03\x88\xda\xce\x60\xb6\xa3\x92\xf3\x28\xc2\xb9\x71\xb2\xfe\x78" ciphertext)
     112        (test "AES-GCM test vector (tag)" "\xab\x6e\x47\xd4\x2c\xec\x13\xbd\xf5\x3a\x67\xb2\x12\x57\xbd\xdf" tag)
     113        (test "AES-GCM test vector (decryption)" plaintext
     114              (string-decrypt-and-verify aes-128-gcm ciphertext tag key iv))))
     115    (let ((key (string->blob "\xfe\xff\xe9\x92\x86\x65\x73\x1c\x6d\x6a\x8f\x94\x67\x30\x83\x08"))
     116          (iv (string->blob "\xca\xfe\xba\xbe\xfa\xce\xdb\xad\xde\xca\xf8\x88"))
     117          (plaintext "\xd9\x31\x32\x25\xf8\x84\x06\xe5\xa5\x59\x09\xc5\xaf\xf5\x26\x9a\x86\xa7\xa9\x53\x15\x34\xf7\xda\x2e\x4c\x30\x3d\x8a\x31\x8a\x72\x1c\x3c\x0c\x95\x95\x68\x09\x53\x2f\xcf\x0e\x24\x49\xa6\xb5\x25\xb1\x6a\xed\xf5\xaa\x0d\xe6\x57\xba\x63\x7b\x39")
     118          (auth-data (string->blob "\xfe\xed\xfa\xce\xde\xad\xbe\xef\xfe\xed\xfa\xce\xde\xad\xbe\xef\xab\xad\xda\xd2")))
     119      (receive (ciphertext tag)
     120          (string-encrypt-and-digest aes-128-gcm plaintext key iv tag-length: 16 auth-data: auth-data)
     121        (test "AES-GCM test vector (encryption)" "\x42\x83\x1e\xc2\x21\x77\x74\x24\x4b\x72\x21\xb7\x84\xd0\xd4\x9c\xe3\xaa\x21\x2f\x2c\x02\xa4\xe0\x35\xc1\x7e\x23\x29\xac\xa1\x2e\x21\xd5\x14\xb2\x54\x66\x93\x1c\x7d\x8f\x6a\x5a\xac\x84\xaa\x05\x1b\xa3\x0b\x39\x6a\x0a\xac\x97\x3d\x58\xe0\x91" ciphertext)
     122        (test "AES-GCM test vector (tag)" "\x5b\xc9\x4f\xbc\x32\x21\xa5\xdb\x94\xfa\xe9\x5a\xe7\x12\x1a\x47" tag)
     123        (test "AES-GCM test vector (decryption)" plaintext
     124              (string-decrypt-and-verify aes-128-gcm ciphertext tag key iv auth-data: auth-data))))))
     125
     126(when aes-128-ccm
     127  (let ((key (string->blob "\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f")))
     128    (let* ((plaintext "\x20\x21\x22\x23")
     129           (message-length (string-length plaintext))
     130           (iv (string->blob "\x10\x11\x12\x13\x14\x15\x16"))
     131           (tag-length 4)
     132           (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07")))
     133      (receive (ciphertext tag)
     134          (string-encrypt-and-digest aes-128-ccm plaintext key iv message-length: message-length tag-length: tag-length auth-data: auth-data)
     135        (test "AES-CCM test vector (encryption)" "\x71\x62\x01\x5b" ciphertext)
     136        (test "AES-CCM test vector (tag)" "\x4d\xac\x25\x5d" tag)
     137        (test "AES-CCM test vector (decryption)" plaintext
     138              (string-decrypt-and-verify aes-128-ccm ciphertext tag key iv message-length: message-length tag-length: tag-length auth-data: auth-data))))
     139    (let* ((plaintext "\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f")
     140           (message-length (string-length plaintext))
     141           (iv-length 8)
     142           (iv (string->blob "\x10\x11\x12\x13\x14\x15\x16\x17"))
     143           (tag-length 6)
     144           (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f")))
     145      (receive (ciphertext tag)
     146          (string-encrypt-and-digest aes-128-ccm plaintext key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data)
     147        (test "AES-CCM test vector (encryption)" "\xd2\xa1\xf0\xe0\x51\xea\x5f\x62\x08\x1a\x77\x92\x07\x3d\x59\x3d" ciphertext)
     148        (test "AES-CCM test vector (tag)" "\x1f\xc6\x4f\xbf\xac\xcd" tag)
     149        (test "AES-CCM test vector (decryption)" plaintext
     150              (string-decrypt-and-verify aes-128-ccm ciphertext tag key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data))))
     151    (let* ((plaintext "\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37")
     152           (message-length (string-length plaintext))
     153           (iv-length 12)
     154           (iv (string->blob "\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b"))
     155           (tag-length 8)
     156           (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13")))
     157      (receive (ciphertext tag)
     158          (string-encrypt-and-digest aes-128-ccm plaintext key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data)
     159        (test "AES-CCM test vector (encryption)" "\xe3\xb2\x01\xa9\xf5\xb7\x1a\x7a\x9b\x1c\xea\xec\xcd\x97\xe7\x0b\x61\x76\xaa\xd9\xa4\x42\x8a\xa5" ciphertext)
     160        (test "AES-CCM test vector (tag)" "\x48\x43\x92\xfb\xc1\xb0\x99\x51" tag)
     161        (test "AES-CCM test vector (decryption)" plaintext
     162              (string-decrypt-and-verify aes-128-ccm ciphertext tag key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data))))))
     163
     164(when aes-128-ocb
     165  (let ((key (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"))
     166        (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07")))
     167    (let ((plaintext "")
     168          (iv (string->blob "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x00")))
     169      (receive (ciphertext tag)
     170          (string-encrypt-and-digest aes-128-ocb plaintext key iv tag-length: 16)
     171        (test "AES-OCB test vector (encryption)" "" ciphertext)
     172        (test "AES-OCB test vector (tag)" "\x78\x54\x07\xbf\xff\xc8\xad\x9e\xdc\xc5\x52\x0a\xc9\x11\x1e\xe6" tag)
     173        (test "AES-OCB test vector (decryption)" plaintext
     174              (string-decrypt-and-verify aes-128-ocb ciphertext tag key iv))))
     175    (let ((plaintext "\x00\x01\x02\x03\x04\x05\x06\x07")
     176          (iv (string->blob "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x01")))
     177      (receive (ciphertext tag)
     178          (string-encrypt-and-digest aes-128-ocb plaintext key iv tag-length: 16 auth-data: auth-data)
     179        (test "AES-OCB test vector (encryption)" "\x68\x20\xb3\x65\x7b\x6f\x61\x5a" ciphertext)
     180        (test "AES-OCB test vector (tag)" "\x57\x25\xbd\xa0\xd3\xb4\xeb\x3a\x25\x7c\x9a\xf1\xf8\xf0\x30\x09" tag)
     181        (test "AES-OCB test vector (decryption)" plaintext
     182              (string-decrypt-and-verify aes-128-ocb ciphertext tag key iv auth-data: auth-data))))
     183    (let ((plaintext "")
     184          (iv (string->blob "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x02")))
     185      (receive (ciphertext tag)
     186          (string-encrypt-and-digest aes-128-ocb plaintext key iv tag-length: 16 auth-data: auth-data)
     187        (test "AES-OCB test vector (encryption)" "" ciphertext)
     188        (test "AES-OCB test vector (tag)" "\x81\x01\x7f\x82\x03\xf0\x81\x27\x71\x52\xfa\xde\x69\x4a\x0a\x00" tag)
     189        (test "AES-OCB test vector (decryption)" plaintext
     190              (string-decrypt-and-verify aes-128-ocb ciphertext tag key iv auth-data: auth-data))))))
    97191
    98192;; https://www.rfc-editor.org/rfc/rfc6229.txt
     
    119213  (test "RC4-256 test vector (decryption)" plaintext
    120214        (encrypt-string cipher "\xea\xa6\xbd\x25\x88\x0b\xf9\x3d" key #f effective-key-length: 32)))
    121 
    122 (when aes-128-gcm
    123   ;; TODO: optional GCM tests
    124   )
    125 
    126 (when aes-128-ccm
    127   ;; TODO: optional CCM tests
    128   )
    129 
    130 (when aes-128-ocb
    131   ;; TODO: optional OCB tests
    132   )
  • release/5/openssl/trunk/tests/digest-test.scm

    r40228 r40245  
    2828
    2929(test "Port API works"
    30       "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e" 
     30      "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e"
    3131      (call-with-output-string
    3232       (lambda (out)
Note: See TracChangeset for help on using the changeset viewer.