Changeset 40227 in project


Ignore:
Timestamp:
06/28/21 09:07:32 (5 weeks ago)
Author:
Vasilij Schneidermann
Message:

openssl: Rework cipher API

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

Legend:

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

    r40222 r40227  
    1010   max-iv-length
    1111   max-block-length
    12    open-cipher-port
     12   cipher-context-allocate!
     13   cipher-context-free!
     14   cipher-context-reset!
     15   cipher-context-init!
     16   cipher-context-update!
     17   cipher-context-final!
     18   string-cipher
    1319   )
    1420
     
    1925(import (chicken foreign))
    2026(import (chicken format))
     27(import (chicken gc))
    2128(import (chicken memory))
    2229(import (chicken port))
     
    5057(define EVP_CIPHER_CTX_new (foreign-lambda EVP_CIPHER_CTX* "EVP_CIPHER_CTX_new"))
    5158(define EVP_CIPHER_CTX_free (foreign-lambda void "EVP_CIPHER_CTX_free" EVP_CIPHER_CTX*))
     59(define EVP_CIPHER_CTX_reset (foreign-lambda bool "EVP_CIPHER_CTX_reset" EVP_CIPHER_CTX*))
    5260(define EVP_CIPHER_CTX_set_padding (foreign-lambda bool "EVP_CIPHER_CTX_set_padding" EVP_CIPHER_CTX* bool))
    5361(define EVP_CIPHER_CTX_key_length (foreign-lambda int "EVP_CIPHER_CTX_key_length" EVP_CIPHER_CTX*))
     
    115123(define max-block-length EVP_MAX_BLOCK_LENGTH)
    116124
    117 (define (open-cipher-port out cipher key iv #!key (mode 'encrypt) (padding #t)
    118                                                   (effective-key-length #f))
     125(define-record cipher-context ptr)
     126
     127(define (cipher-context-free! context)
     128  (and-let* ((ctx (cipher-context-ptr context)))
     129    (EVP_CIPHER_CTX_free ctx)
     130    (cipher-context-ptr-set! context #f)))
     131
     132(define (cipher-context-allocate!)
     133  (ERR_clear_error)
     134  (let ((ctx (EVP_CIPHER_CTX_new)))
     135    (when (not ctx)
     136      (openssl-error 'cipher-context-allocate!))
     137    (set-finalizer! (make-cipher-context ctx) cipher-context-free!)))
     138
     139(define (cipher-context-reset! context)
     140  (and-let* ((ctx (cipher-context-ptr context)))
     141    (ERR_clear_error)
     142    (when (not (EVP_CIPHER_CTX_reset ctx))
     143      (openssl-error 'cipher-context-reset!))
     144    (void)))
     145
     146(define cipher/encrypt 1)
     147(define cipher/decrypt 0)
     148
     149;; TODO: effective-iv-length
     150;; TODO: auth-data
     151;; TODO: tag-length
     152;; TODO: message-length
     153(define (cipher-context-init! context cipher key iv #!key
     154                              (mode 'encrypt)
     155                              (padding #t)
     156                              (effective-key-length #f))
    119157  (define (mode->flag mode)
    120158    (case mode
    121159      ((encrypt) 1)
    122160      ((decrypt) 0)
    123       (else (openssl-type-error 'open-cipher-port "mode symbol" (list mode)))))
    124   (ERR_clear_error)
    125   (let* ((ctx (EVP_CIPHER_CTX_new))
    126          (key-length (or effective-key-length (blob-size key)))
    127          (iv-length (and iv (blob-size iv))))
    128     (when (not (EVP_CipherInit_ex ctx cipher #f #f #f (mode->flag mode)))
    129       (EVP_CIPHER_CTX_free ctx)
    130       (openssl-error 'open-cipher-port (list cipher mode)))
    131     (when (> key-length (blob-size key))
    132       (openssl-type-error "effective key length <= key size" key-length (blob-size key)))
    133     (when (not (EVP_CIPHER_CTX_set_key_length ctx key-length))
    134       (EVP_CIPHER_CTX_free ctx)
    135       (openssl-error 'open-cipher-port (list key-length effective-key-length)))
    136     (when (and iv-length (not (<= (EVP_CIPHER_CTX_iv_length ctx) iv-length)))
    137       (EVP_CIPHER_CTX_free ctx)
    138       (openssl-type-error 'open-cipher-port "sufficient iv length" iv-length))
    139     (when (not (EVP_CipherInit_ex ctx #f #f key iv -1))
    140       (EVP_CIPHER_CTX_free ctx)
    141       (openssl-error 'open-cipher-port (list cipher key iv)))
    142     (EVP_CIPHER_CTX_set_padding ctx padding)
    143     (make-output-port
    144      (lambda (str)
    145        (let* ((in-blob (string->blob str))
    146               (in-length (string-length str))
    147               (out-blob (make-blob (+ in-length max-block-length))))
    148          (let-location ((out-length int))
    149            (when (not (EVP_CipherUpdate ctx out-blob (location out-length) in-blob in-length))
    150              (EVP_CIPHER_CTX_free ctx)
    151              (openssl-error 'open-cipher-port (list in-blob in-length)))
    152            (let ((out-str (make-string out-length)))
    153              (move-memory! out-blob out-str out-length)
    154              (display out-str out)))))
    155      (lambda ()
    156        (let ((out-blob (make-blob max-block-length)))
    157          (let-location ((out-length int))
    158            (when (not (EVP_CipherFinal_ex ctx out-blob (location out-length)))
    159              (EVP_CIPHER_CTX_free ctx)
    160              (openssl-error 'open-cipher-port))
    161            (let ((out-str (make-string out-length)))
    162              (move-memory! out-blob out-str out-length)
    163              (display out-str out))))
    164        (EVP_CIPHER_CTX_free ctx))
    165      (lambda ()
    166        (flush-output out)))))
     161      (else (openssl-type-error 'cipher-context-init! "mode symbol" (list mode)))))
     162  (and-let* ((ctx (cipher-context-ptr context)))
     163    (ERR_clear_error)
     164    (let ((key-length (or effective-key-length (blob-size key)))
     165          (iv-length (and iv (blob-size iv))))
     166      (when (not (EVP_CipherInit_ex ctx cipher #f #f #f (mode->flag mode)))
     167        (openssl-error 'cipher-context-init! (list cipher mode)))
     168      (when (> key-length (blob-size key))
     169        (openssl-type-error "effective key length <= key size" key-length (blob-size key)))
     170      (when (not (EVP_CIPHER_CTX_set_key_length ctx key-length))
     171        (openssl-error 'cipher-context-init! (list key-length effective-key-length)))
     172      (when (and iv-length (not (<= (EVP_CIPHER_CTX_iv_length ctx) iv-length)))
     173        (openssl-type-error 'cipher-context-init! "sufficient iv length" iv-length))
     174      (when (not (EVP_CipherInit_ex ctx #f #f key iv -1))
     175        (openssl-error 'cipher-context-init! (list cipher key iv)))
     176      (EVP_CIPHER_CTX_set_padding ctx padding)
     177      (void))))
     178
     179(define (cipher-context-update! context blob)
     180  (and-let* ((ctx (cipher-context-ptr context))
     181             (buf (make-blob (+ (blob-size blob) max-block-length))))
     182    (ERR_clear_error)
     183    (let-location ((buf-length int))
     184      (when (not (EVP_CipherUpdate ctx buf (location buf-length) blob (blob-size blob)))
     185        (openssl-error 'cipher-context-update! (list blob (blob-size blob))))
     186      (let ((ret (make-blob buf-length)))
     187        (move-memory! buf ret buf-length)
     188        ret))))
     189
     190(define (cipher-context-final! context)
     191  (and-let* ((ctx (cipher-context-ptr context))
     192             (buf (make-blob max-block-length)))
     193    (ERR_clear_error)
     194    (let-location ((buf-length int))
     195      (when (not (EVP_CipherFinal_ex ctx buf (location buf-length)))
     196        (openssl-error 'cipher-context-final!))
     197      (let ((ret (make-blob buf-length)))
     198        (move-memory! buf ret buf-length)
     199        ret))))
     200
     201(define (string-cipher cipher str key iv #!rest options)
     202  (let ((context (cipher-context-allocate!)))
     203    (apply cipher-context-init! context cipher key iv options)
     204    (let* ((output (cipher-context-update! context (string->blob str)))
     205           (final (cipher-context-final! context)))
     206      (cipher-context-free! context)
     207      (string-append (blob->string output) (blob->string final)))))
    167208
    168209)
  • release/5/openssl/trunk/openssl.digest.scm

    r40223 r40227  
    5656(define EVP_MD_CTX_new (foreign-lambda EVP_MD_CTX* "EVP_MD_CTX_new"))
    5757(define EVP_MD_CTX_free (foreign-lambda void "EVP_MD_CTX_free" EVP_MD_CTX*))
    58 (define EVP_MD_CTX_reset (foreign-lambda int "EVP_MD_CTX_reset" EVP_MD_CTX*))
     58(define EVP_MD_CTX_reset (foreign-lambda bool "EVP_MD_CTX_reset" EVP_MD_CTX*))
    5959(define EVP_MD_CTX_set_flags (foreign-lambda void "EVP_MD_CTX_set_flags" EVP_MD_CTX* int))
    6060
     
    164164    (digest-context-init! context digest oneshot: #t)
    165165    (digest-context-update! context (string->blob str))
    166     (digest-context-final! context)))
     166    (let ((ret (digest-context-final! context)))
     167      (digest-context-free! context)
     168      ret)))
    167169
    168170(define (file-digest digest path)
     
    178180          (loop))))
    179181    (file-close in)
    180     (digest-context-final! context)))
     182    (let ((ret (digest-context-final! context)))
     183      (digest-context-free! context)
     184      ret)))
    181185
    182186)
  • release/5/openssl/trunk/openssl.egg

    r40222 r40227  
    77 (test-dependencies test)
    88 (foreign-dependencies "openssl-1.1.0")
     9 (component-options (csc-options "-O3" "-d1"))
    910 (components (extension openssl (custom-build "build-openssl")
    1011                        (component-dependencies openssl.socket))
  • release/5/openssl/trunk/tests/cipher-test.scm

    r40222 r40227  
    33(define aes-128-ctr (cipher-by-name "aes-128-ctr"))
    44(define aes-128-gcm (cipher-by-name "aes-128-gcm"))
     5(define aes-128-ccm (cipher-by-name "aes-128-ccm"))
     6(define aes-128-ocb (cipher-by-name "aes-128-ocb"))
    57(define rc4 (cipher-by-name "rc4"))
    68
     
    1618(test-assert "Bogus cipher" (not (cipher-by-name "aes-128-abc")))
    1719
    18 (define (perform-cipher-on-string str cipher key iv #!rest opts)
    19   (call-with-output-string
    20    (lambda (out)
    21      (let ((out (apply open-cipher-port out cipher key iv opts)))
    22        (write-string str #f out)
    23        (close-output-port out)))))
     20;; TODO: test low-level API
    2421
    25 (define (encrypt-string plaintext cipher key iv #!rest opts)
    26   (apply perform-cipher-on-string plaintext cipher key iv mode: 'encrypt opts))
     22(define (encrypt-string cipher plaintext key iv #!rest opts)
     23  (apply string-cipher cipher plaintext key iv mode: 'encrypt opts))
    2724
    28 (define (decrypt-string ciphertext cipher key iv #!rest opts)
    29   (apply perform-cipher-on-string ciphertext cipher key iv mode: 'decrypt opts))
     25(define (decrypt-string cipher ciphertext key iv #!rest opts)
     26  (apply string-cipher cipher ciphertext key iv mode: 'decrypt opts))
    3027
    3128(define (test-roundtrip cipher)
     
    3835                            (cipher-name cipher)
    3936                            (string-length plaintext)))
    40              (ciphertext (encrypt-string plaintext cipher key iv)))
    41          (test label plaintext (decrypt-string ciphertext cipher key iv))))
     37             (ciphertext (encrypt-string cipher plaintext key iv)))
     38         (test label plaintext (decrypt-string cipher ciphertext key iv))))
    4239     plaintexts)))
    4340
     
    4845       (key-length (cipher-key-length cipher))
    4946       (iv-length (cipher-iv-length cipher)))
    50   (test-error "Encryption with bogus algorithm" (encrypt-string "" #f (random-bytes key-length) (random-bytes iv-length)))
    51   (test-error "Encryption with too small key" (encrypt-string "" cipher (random-bytes 1) (random-bytes iv-length)))
    52   (test-error "Encryption with too big key" (encrypt-string "" cipher (random-bytes (add1 max-key-length)) (random-bytes iv-length)))
    53   (test-error "Encryption with too small IV" (encrypt-string "" cipher (random-bytes key-length) (random-bytes 1)))
    54   (test-assert "Encryption with too big IV" (encrypt-string "" cipher (random-bytes key-length) (random-bytes (add1 max-iv-length))))
    55   (test-assert "Encryption without IV in ECB mode" (encrypt-string "" cipher (random-bytes key-length) #f))
    56   (test-assert "Encryption of unpadded empty input" (encrypt-string "" cipher (random-bytes key-length) (random-bytes iv-length) padding: #f))
    57   (test-error "Encryption of unpadded input" (encrypt-string "abc" cipher (random-bytes key-length) (random-bytes iv-length) padding: #f))
    58   (test-assert "Encryption of manually padded input" (encrypt-string (string-append "abc" (make-string 13 (integer->char 13))) cipher (random-bytes key-length) (random-bytes iv-length) padding: #f)))
     47  (test-error "Encryption with bogus algorithm" (encrypt-string #f "" (random-bytes key-length) (random-bytes iv-length)))
     48  (test-error "Encryption with too small key" (encrypt-string cipher "" (random-bytes 1) (random-bytes iv-length)))
     49  (test-error "Encryption with too big key" (encrypt-string cipher "" (random-bytes (add1 max-key-length)) (random-bytes iv-length)))
     50  (test-error "Encryption with too small IV" (encrypt-string cipher "" (random-bytes key-length) (random-bytes 1)))
     51  (test-assert "Encryption with too big IV" (encrypt-string cipher "" (random-bytes key-length) (random-bytes (add1 max-iv-length))))
     52  (test-assert "Encryption without IV in ECB mode" (encrypt-string cipher "" (random-bytes key-length) #f))
     53  (test-assert "Encryption of unpadded empty input" (encrypt-string cipher "" (random-bytes key-length) (random-bytes iv-length) padding: #f))
     54  (test-error "Encryption of unpadded input" (encrypt-string cipher "abc" (random-bytes key-length) (random-bytes iv-length) padding: #f))
     55  (test-assert "Encryption of manually padded input" (encrypt-string cipher (string-append "abc" (make-string 13 (integer->char 13))) (random-bytes key-length) (random-bytes iv-length) padding: #f)))
    5956
    6057;; https://nvlpubs.nist.gov/nistpubs/Legacy/SP/nistspecialpublication800-38a.pdf
     
    6259      (plaintext "\x6b\xc1\xbe\xe2\x2e\x40\x9f\x96\xe9\x3d\x7e\x11\x73\x93\x17\x2a"))
    6360  (let ((ciphertext "\x3a\xd7\x7b\xb4\x0d\x7a\x36\x60\xa8\x9e\xca\xf3\x24\x66\xef\x97"))
    64     (test "AES-128-ECB test vector (encryption)" ciphertext (encrypt-string plaintext aes-128-ecb key #f padding: #f))
    65     (test "AES-128-ECB test vector (decryption)" plaintext (decrypt-string ciphertext aes-128-ecb key #f padding: #f)))
     61    (test "AES-128-ECB test vector (encryption)" ciphertext (encrypt-string aes-128-ecb plaintext key #f padding: #f))
     62    (test "AES-128-ECB test vector (decryption)" plaintext (decrypt-string aes-128-ecb ciphertext key #f padding: #f)))
    6663  (let ((iv (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"))
    6764        (ciphertext "\x76\x49\xab\xac\x81\x19\xb2\x46\xce\xe9\x8e\x9b\x12\xe9\x19\x7d"))
    68     (test "AES-128-CBC test vector (encryption)" ciphertext (encrypt-string plaintext aes-128-cbc key iv padding: #f))
    69     (test "AES-128-CBC test vector (decryption)" plaintext (decrypt-string ciphertext aes-128-cbc key iv padding: #f)))
     65    (test "AES-128-CBC test vector (encryption)" ciphertext (encrypt-string aes-128-cbc plaintext key iv padding: #f))
     66    (test "AES-128-CBC test vector (decryption)" plaintext (decrypt-string aes-128-cbc ciphertext key iv padding: #f)))
    7067  (let ((iv (string->blob "\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff"))
    7168        (ciphertext "\x87\x4d\x61\x91\xb6\x20\xe3\x26\x1b\xef\x68\x64\x99\x0d\xb6\xce"))
    72     (test "AES-128-CTR test vector (encryption)" ciphertext (encrypt-string plaintext aes-128-ctr key iv))
    73     (test "AES-128-CTR test vector (decryption)" plaintext (decrypt-string ciphertext aes-128-ctr key iv))))
     69    (test "AES-128-CTR test vector (encryption)" ciphertext (encrypt-string aes-128-ctr plaintext key iv))
     70    (test "AES-128-CTR test vector (decryption)" plaintext (decrypt-string aes-128-ctr ciphertext key iv))))
    7471
    7572;; https://www.rfc-editor.org/rfc/rfc6229.txt
     
    7976       (iv #f))
    8077  (test-error "RC4-40 with invalid key length"
    81         (encrypt-string plaintext cipher (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 10))
     78        (encrypt-string cipher plaintext (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 10))
    8279  (test "RC4-40 test vector (encryption)" "\xb2\x39\x63\x05\xf0\x3d\xc0\x27"
    83         (encrypt-string plaintext cipher (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 5))
     80        (encrypt-string cipher plaintext (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 5))
    8481  (test "RC4-40 test vector (decryption)" plaintext
    85         (decrypt-string "\xb2\x39\x63\x05\xf0\x3d\xc0\x27" cipher (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 5))
     82        (decrypt-string cipher "\xb2\x39\x63\x05\xf0\x3d\xc0\x27" (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 5))
    8683  (test "RC4-80 test vector (encryption)" "\xed\xe3\xb0\x46\x43\xe5\x86\xcc"
    87         (encrypt-string plaintext cipher key #f effective-key-length: 10))
     84        (encrypt-string cipher plaintext key #f effective-key-length: 10))
    8885  (test "RC4-80 test vector (decryption)" plaintext
    89         (decrypt-string "\xed\xe3\xb0\x46\x43\xe5\x86\xcc" cipher key #f effective-key-length: 10))
     86        (decrypt-string cipher "\xed\xe3\xb0\x46\x43\xe5\x86\xcc" key #f effective-key-length: 10))
    9087  (test "RC4-128 test vector (encryption)" "\x9a\xc7\xcc\x9a\x60\x9d\x1e\xf7"
    91         (encrypt-string plaintext cipher key #f effective-key-length: 16))
     88        (encrypt-string cipher plaintext key #f effective-key-length: 16))
    9289  (test "RC4-128 test vector (decryption)" plaintext
    93         (decrypt-string "\x9a\xc7\xcc\x9a\x60\x9d\x1e\xf7" cipher key #f effective-key-length: 16))
     90        (decrypt-string cipher "\x9a\xc7\xcc\x9a\x60\x9d\x1e\xf7" key #f effective-key-length: 16))
    9491  (test "RC4-256 test vector (encryption)" "\xea\xa6\xbd\x25\x88\x0b\xf9\x3d"
    95         (encrypt-string plaintext cipher key #f effective-key-length: 32))
     92        (encrypt-string cipher plaintext key #f effective-key-length: 32))
    9693  (test "RC4-256 test vector (decryption)" plaintext
    97         (encrypt-string "\xea\xa6\xbd\x25\x88\x0b\xf9\x3d" cipher key #f effective-key-length: 32)))
     94        (encrypt-string cipher "\xea\xa6\xbd\x25\x88\x0b\xf9\x3d" key #f effective-key-length: 32)))
    9895
    99 ;; TODO: GCM
    100 ;; TODO: CCM
    101 ;; TODO: OCB
     96(when aes-128-gcm
     97  ;; TODO: optional GCM tests
     98  )
     99
     100(when aes-128-ccm
     101  ;; TODO: optional CCM tests
     102  )
     103
     104(when aes-128-ocb
     105  ;; TODO: optional OCB tests
     106  )
  • release/5/openssl/trunk/tests/digest-test.scm

    r40222 r40227  
    1717(test "Digest block sizes" '(64 64 64) (map digest-block-size (list md5 sha1 sha256)))
    1818
     19(let ((ctx (digest-context-allocate!)))
     20  (digest-context-init! ctx md5)
     21  (digest-context-update! ctx (make-blob 0))
     22  (test "Low-level API works" "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e" (digest-context-final! ctx))
     23  (digest-context-reset! ctx)
     24  (digest-context-init! ctx md5)
     25  (digest-context-update! ctx (make-blob 0))
     26  (test "Resetting the context works" "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e" (digest-context-final! ctx))
     27  (digest-context-free! ctx))
     28
    1929(test "MD5 hash (empty)" "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e" (string-digest md5 ""))
    2030(test "MD5 hash (short)" "\x90\x01\x50\x98\x3c\xd2\x4f\xb0\xd6\x96\x3f\x7d\x28\xe1\x7f\x72" (string-digest md5 "abc"))
     
    2636(test "SHA256 hash (short)" "\xdf\xf2\xe7\x30\x91\xf6\xc0\x5e\x52\x88\x96\xc4\xc8\x31\xb9\x44\x86\x53\xdc\x2f\xf0\x43\x52\x8f\x67\x69\x43\x7b\xc7\xb9\x75\xc2" (string-digest sha256 "\xb4\x19\x0e"))
    2737(test "SHA256 hash (long)" "\x6d\xd5\x2b\x0d\x8b\x48\xcc\x81\x46\xce\xbd\x02\x16\xfb\xf5\xf6\xef\x7e\xea\xfc\x0f\xf2\xff\x9d\x14\x22\xd6\x34\x55\x55\xa1\x42" (string-digest sha256 "\xc1\xef\x39\xce\xe5\x8e\x78\xf6\xfc\xdc\x12\xe0\x58\xb7\xf9\x02\xac\xd1\xa9\x3b"))
     38
     39(define test-file (create-temporary-file))
     40(on-exit (lambda () (delete-file* test-file)))
     41
     42(test "File MD5 hash (empty)" "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e" (file-digest md5 test-file))
     43(test "File SHA1 hash (empty)" "\xda\x39\xa3\xee\x5e\x6b\x4b\x0d\x32\x55\xbf\xef\x95\x60\x18\x90\xaf\xd8\x07\x09" (file-digest sha1 test-file))
     44(test "File SHA256 hash (empty)" "\xe3\xb0\xc4\x42\x98\xfc\x1c\x14\x9a\xfb\xf4\xc8\x99\x6f\xb9\x24\x27\xae\x41\xe4\x64\x9b\x93\x4c\xa4\x95\x99\x1b\x78\x52\xb8\x55" (file-digest sha256 test-file))
Note: See TracChangeset for help on using the changeset viewer.