Changeset 40222 in project


Ignore:
Timestamp:
06/27/21 12:06:48 (5 weeks ago)
Author:
Vasilij Schneidermann
Message:

openssl: Rework digest API

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

Legend:

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

    r40214 r40222  
    115115(define max-block-length EVP_MAX_BLOCK_LENGTH)
    116116
    117 ;; TODO: AEAD operations
    118 ;; TODO: GCM and OCB tests
    119 ;; TODO: CCM tests
    120117(define (open-cipher-port out cipher key iv #!key (mode 'encrypt) (padding #t)
    121118                                                  (effective-key-length #f))
     
    126123      (else (openssl-type-error 'open-cipher-port "mode symbol" (list mode)))))
    127124  (ERR_clear_error)
    128   (let ((ctx (EVP_CIPHER_CTX_new))
    129         (key-length (blob-size key))
    130         (iv-length (and iv (blob-size iv))))
     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))))
    131128    (when (not (EVP_CipherInit_ex ctx cipher #f #f #f (mode->flag mode)))
    132129      (EVP_CIPHER_CTX_free ctx)
    133130      (openssl-error 'open-cipher-port (list cipher mode)))
    134     (when (and (not effective-key-length)
    135                (not (<= (EVP_CIPHER_CTX_key_length ctx) key-length)))
     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))
    136134      (EVP_CIPHER_CTX_free ctx)
    137       (openssl-type-error 'open-cipher-port "sufficient key length" key-length))
     135      (openssl-error 'open-cipher-port (list key-length effective-key-length)))
    138136    (when (and iv-length (not (<= (EVP_CIPHER_CTX_iv_length ctx) iv-length)))
    139137      (EVP_CIPHER_CTX_free ctx)
    140138      (openssl-type-error 'open-cipher-port "sufficient iv length" iv-length))
    141     (when effective-key-length
    142       (when (not (<= effective-key-length key-length))
    143         (openssl-type-error 'open-cipher-port "valid effective key length"
    144                              effective-key-length))
    145       (when (not (EVP_CIPHER_CTX_set_key_length ctx effective-key-length))
    146         (EVP_CIPHER_CTX_free ctx)
    147         (openssl-error 'open-cipher-port (list key-length effective-key-length))))
    148139    (when (not (EVP_CipherInit_ex ctx #f #f key iv -1))
    149140      (EVP_CIPHER_CTX_free ctx)
  • release/5/openssl/trunk/openssl.digest.scm

    r40214 r40222  
    77   digest-name
    88   max-digest-size
    9    open-digest-port
     9   digest-context-allocate!
     10   digest-context-reset!
     11   digest-context-init!
     12   digest-context-update!
     13   digest-context-final!
     14   string-digest
     15   file-digest
    1016   )
    1117
     
    1420(import (chicken blob))
    1521(import (chicken condition))
     22(import (chicken file posix))
    1623(import (chicken foreign))
    1724(import (chicken format))
     25(import (chicken gc))
     26(import (chicken io))
    1827(import (chicken memory))
    1928(import (chicken port))
     
    4655(define EVP_MD_CTX_new (foreign-lambda EVP_MD_CTX* "EVP_MD_CTX_new"))
    4756(define EVP_MD_CTX_free (foreign-lambda void "EVP_MD_CTX_free" EVP_MD_CTX*))
     57(define EVP_MD_CTX_reset (foreign-lambda int "EVP_MD_CTX_reset" EVP_MD_CTX*))
     58(define EVP_MD_CTX_set_flags (foreign-lambda void "EVP_MD_CTX_set_flags" EVP_MD_CTX* int))
    4859
    4960(define EVP_DigestInit_ex (foreign-lambda bool "EVP_DigestInit_ex" EVP_MD_CTX* EVP_MD* c-pointer))
     
    5768
    5869(define EVP_MAX_MD_SIZE (foreign-value "EVP_MAX_MD_SIZE" int))
     70(define EVP_MD_CTX_FLAG_ONESHOT (foreign-value "EVP_MD_CTX_FLAG_ONESHOT" int))
    5971
    6072(define (openssl-type-error loc expected #!rest args)
     
    98110(define max-digest-size EVP_MAX_MD_SIZE)
    99111
    100 (define (open-digest-port out digest)
     112(define-record digest-context ptr)
     113
     114(define (digest-context-free! context)
     115  (and-let* ((ctx (digest-context-ptr context)))
     116    (EVP_MD_CTX_free ctx)
     117    (digest-context-ptr-set! context #f)))
     118
     119(define (digest-context-allocate!)
    101120  (ERR_clear_error)
    102121  (let ((ctx (EVP_MD_CTX_new)))
     122    (when (not ctx)
     123      (openssl-error 'digest-context-allocate!))
     124    (set-finalizer! (make-digest-context ctx) digest-context-free!)))
     125
     126(define (digest-context-reset! context)
     127  (ERR_clear_error)
     128  (and-let* ((ctx (digest-context-ptr context)))
     129    (when (not (EVP_MD_CTX_reset ctx))
     130      (openssl-error 'digest-context-reset!))
     131    (void)))
     132
     133(define (digest-context-init! context digest #!key (oneshot #f))
     134  (ERR_clear_error)
     135  (and-let* ((ctx (digest-context-ptr context)))
    103136    (when (not (EVP_DigestInit_ex ctx digest #f))
    104       (EVP_MD_CTX_free ctx)
    105       (openssl-error 'open-digest-port (list digest)))
    106     (make-output-port
    107      (lambda (str)
    108        (let ((in-blob (string->blob str))
    109              (in-length (string-length str)))
    110          (when (not (EVP_DigestUpdate ctx in-blob in-length))
    111            (EVP_MD_CTX_free ctx)
    112            (openssl-error 'open-digest-port (list in-blob in-length)))))
    113      (lambda ()
    114        (let ((out-blob (make-blob max-digest-size)))
    115          (let-location ((out-length int))
    116            (when (not (EVP_DigestFinal_ex ctx out-blob (location out-length)))
    117              (EVP_MD_CTX_free ctx)
    118              (openssl-error 'open-digest-port))
    119            (let ((out-str (make-string out-length)))
    120              (move-memory! out-blob out-str out-length)
    121              (display out-str out))))
    122        (EVP_MD_CTX_free ctx))
    123      (lambda ()
    124        (flush-output out)))))
     137      (openssl-error 'digest-context-init! (list digest)))
     138    (when oneshot
     139      (EVP_MD_CTX_set_flags ctx EVP_MD_CTX_FLAG_ONESHOT))
     140    (void)))
     141
     142(define (digest-context-update! context blob)
     143  (ERR_clear_error)
     144  (and-let* ((ctx (digest-context-ptr context))
     145             (size (blob-size blob)))
     146    (when (not (EVP_DigestUpdate ctx blob size))
     147      (openssl-error 'digest-context-update (list blob size)))
     148    (void)))
     149
     150(define (digest-context-final! context)
     151  (ERR_clear_error)
     152  (and-let* ((ctx (digest-context-ptr context))
     153             (blob (make-blob max-digest-size)))
     154    (let-location ((size int))
     155      (when (not (EVP_DigestFinal_ex (digest-context-ptr context) blob (location size)))
     156        (openssl-error 'digest-context-final!))
     157      (let ((str (make-string size)))
     158        (move-memory! blob str size)
     159        str))))
     160
     161(define (string-digest digest str)
     162  (let ((context (digest-context-allocate!)))
     163    (digest-context-init! context digest oneshot: #t)
     164    (digest-context-update! context (string->blob str))
     165    (digest-context-final! context)))
     166
     167(define (file-digest digest path)
     168  (let* ((buf-size 4096)
     169         (buf (make-blob buf-size))
     170         (context (digest-context-allocate!))
     171         (in (file-open path open/rdonly)))
     172    (digest-context-init! context digest)
     173    (let loop ()
     174      (let ((count (cadr (file-read in buf-size buf))))
     175        (when (positive? count)
     176          (digest-context-update! context buf)
     177          (loop))))
     178    (file-close in)
     179    (digest-context-final! context)))
    125180
    126181)
  • release/5/openssl/trunk/openssl.egg

    r40214 r40222  
    44 (license "BSD")
    55 (category net)
    6  (dependencies srfi-13 srfi-18 srfi-69 address-info)
     6 (dependencies srfi-13 srfi-18 address-info)
     7 (test-dependencies test)
    78 (foreign-dependencies "openssl-1.1.0")
    89 (components (extension openssl (custom-build "build-openssl")
  • release/5/openssl/trunk/tests/cipher-test.scm

    r40214 r40222  
    5050  (test-error "Encryption with bogus algorithm" (encrypt-string "" #f (random-bytes key-length) (random-bytes iv-length)))
    5151  (test-error "Encryption with too small key" (encrypt-string "" cipher (random-bytes 1) (random-bytes iv-length)))
    52   (test-assert "Encryption with too big key" (encrypt-string "" cipher (random-bytes (add1 max-key-length)) (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)))
    5353  (test-error "Encryption with too small IV" (encrypt-string "" cipher (random-bytes key-length) (random-bytes 1)))
    5454  (test-assert "Encryption with too big IV" (encrypt-string "" cipher (random-bytes key-length) (random-bytes (add1 max-iv-length))))
     
    7878       (plaintext "\x00\x00\x00\x00\x00\x00\x00\x00")
    7979       (iv #f))
     80  (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))
    8082  (test "RC4-40 test vector (encryption)" "\xb2\x39\x63\x05\xf0\x3d\xc0\x27"
    8183        (encrypt-string plaintext cipher (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 5))
  • release/5/openssl/trunk/tests/digest-test.scm

    r40214 r40222  
    1717(test "Digest block sizes" '(64 64 64) (map digest-block-size (list md5 sha1 sha256)))
    1818
    19 (define (digest-to-string str digest)
    20   (call-with-output-string
    21    (lambda (out)
    22      (let ((out (open-digest-port out digest)))
    23        (write-string str #f out)
    24        (close-output-port out)))))
    25 
    26 (test "MD5 hash (empty)" "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e" (digest-to-string "" md5))
    27 (test "MD5 hash (short)" "\x90\x01\x50\x98\x3c\xd2\x4f\xb0\xd6\x96\x3f\x7d\x28\xe1\x7f\x72" (digest-to-string "abc" md5))
    28 (test "MD5 hash (long)" "\xc3\xfc\xd3\xd7\x61\x92\xe4\x00\x7d\xfb\x49\x6c\xca\x67\xe1\x3b" (digest-to-string "abcdefghijklmnopqrstuvwxyz" md5))
    29 (test "SHA1 hash (empty)" "\xda\x39\xa3\xee\x5e\x6b\x4b\x0d\x32\x55\xbf\xef\x95\x60\x18\x90\xaf\xd8\x07\x09" (digest-to-string "" sha1))
    30 (test "SHA1 hash (short)" "\xbf\x36\xed\x5d\x74\x72\x7d\xfd\x5d\x78\x54\xec\x6b\x1d\x49\x46\x8d\x8e\xe8\xaa" (digest-to-string "\xdf\x4b\xd2" sha1))
    31 (test "SHA1 hash (long)" "\x8b\xb8\xc0\xd8\x15\xa9\xc6\x8a\x1d\x29\x10\xf3\x9d\x94\x26\x03\xd8\x07\xfb\xcc" (digest-to-string "\x63\xa3\xcc\x83\xfd\x1e\xc1\xb6\x68\x0e\x99\x74\xa0\x51\x4e\x1a\x9e\xce\xbb\x6a" sha1))
    32 (test "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" (digest-to-string "" sha256))
    33 (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" (digest-to-string "\xb4\x19\x0e" sha256))
    34 (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" (digest-to-string "\xc1\xef\x39\xce\xe5\x8e\x78\xf6\xfc\xdc\x12\xe0\x58\xb7\xf9\x02\xac\xd1\xa9\x3b" sha256))
     19(test "MD5 hash (empty)" "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e" (string-digest md5 ""))
     20(test "MD5 hash (short)" "\x90\x01\x50\x98\x3c\xd2\x4f\xb0\xd6\x96\x3f\x7d\x28\xe1\x7f\x72" (string-digest md5 "abc"))
     21(test "MD5 hash (long)" "\xc3\xfc\xd3\xd7\x61\x92\xe4\x00\x7d\xfb\x49\x6c\xca\x67\xe1\x3b" (string-digest md5 "abcdefghijklmnopqrstuvwxyz"))
     22(test "SHA1 hash (empty)" "\xda\x39\xa3\xee\x5e\x6b\x4b\x0d\x32\x55\xbf\xef\x95\x60\x18\x90\xaf\xd8\x07\x09" (string-digest sha1 ""))
     23(test "SHA1 hash (short)" "\xbf\x36\xed\x5d\x74\x72\x7d\xfd\x5d\x78\x54\xec\x6b\x1d\x49\x46\x8d\x8e\xe8\xaa" (string-digest sha1 "\xdf\x4b\xd2"))
     24(test "SHA1 hash (long)" "\x8b\xb8\xc0\xd8\x15\xa9\xc6\x8a\x1d\x29\x10\xf3\x9d\x94\x26\x03\xd8\x07\xfb\xcc" (string-digest sha1 "\x63\xa3\xcc\x83\xfd\x1e\xc1\xb6\x68\x0e\x99\x74\xa0\x51\x4e\x1a\x9e\xce\xbb\x6a"))
     25(test "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" (string-digest sha256 ""))
     26(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"))
     27(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"))
Note: See TracChangeset for help on using the changeset viewer.