Changeset 40228 in project


Ignore:
Timestamp:
06/28/21 13:16:36 (4 weeks ago)
Author:
Vasilij Schneidermann
Message:

openssl: Reintroduce port APIs on top of low-level ones

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

Legend:

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

    r40227 r40228  
    1717   cipher-context-final!
    1818   string-cipher
     19   file-cipher
     20   open-cipher-port
    1921   )
    2022
     
    2325(import (chicken blob))
    2426(import (chicken condition))
     27(import (chicken file posix))
    2528(import (chicken foreign))
    2629(import (chicken format))
     
    162165  (and-let* ((ctx (cipher-context-ptr context)))
    163166    (ERR_clear_error)
     167    (when (not (EVP_CipherInit_ex ctx cipher #f #f #f (mode->flag mode)))
     168      (openssl-error 'cipher-context-init! (list cipher mode)))
    164169    (let ((key-length (or effective-key-length (blob-size key)))
    165170          (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)))
    168171      (when (> key-length (blob-size key))
    169172        (openssl-type-error "effective key length <= key size" key-length (blob-size key)))
     
    207210      (string-append (blob->string output) (blob->string final)))))
    208211
     212(define (file-cipher cipher in-path out-path key iv #!rest options)
     213  (let* ((buf-size 4096)
     214         (buf (make-blob buf-size))
     215         (context (cipher-context-allocate!))
     216         (in (file-open in-path open/rdonly))
     217         (out (file-open out-path
     218                         (+ open/wronly open/creat open/trunc)
     219                         (+ perm/irusr perm/iwusr))))
     220    (apply cipher-context-init! context cipher key iv options)
     221    (let loop ()
     222      (let ((count (cadr (file-read in buf-size buf))))
     223        (when (positive? count)
     224          (file-write out (cipher-context-update! context buf))
     225          (loop))))
     226    (file-write out (cipher-context-final! context))
     227    (file-close in)
     228    (file-close out)
     229    (cipher-context-free! context)))
     230
     231(define (open-cipher-port out cipher key iv #!rest options)
     232  (let ((context (cipher-context-allocate!)))
     233    (apply cipher-context-init! context cipher key iv options)
     234    (make-output-port
     235     (lambda (str)
     236       (display (blob->string (cipher-context-update! context (string->blob str))) out))
     237     (lambda ()
     238       (display (blob->string (cipher-context-final! context)) out))
     239     (lambda ()
     240       (flush-output out)))))
     241
    209242)
  • release/5/openssl/trunk/openssl.digest.scm

    r40227 r40228  
    1515   string-digest
    1616   file-digest
     17   open-digest-port
    1718   )
    1819
     
    184185      ret)))
    185186
     187(define (open-digest-port out digest)
     188  (let ((context (digest-context-allocate!)))
     189    (digest-context-init! context digest)
     190    (make-output-port
     191     (lambda (str)
     192       (digest-context-update! context (string->blob str)))
     193     (lambda ()
     194       (display (digest-context-final! context) out))
     195     (lambda ()
     196       (flush-output out)))))
     197
    186198)
  • release/5/openssl/trunk/tests/cipher-test.scm

    r40227 r40228  
    1818(test-assert "Bogus cipher" (not (cipher-by-name "aes-128-abc")))
    1919
    20 ;; TODO: test low-level API
     20(let ((ctx (cipher-context-allocate!))
     21      (key (string->blob "YELLOW SUBMARINE"))
     22      (iv #f))
     23  (cipher-context-init! ctx aes-128-ecb key iv)
     24  (let* ((ciphertext (blob->string (cipher-context-update! ctx (string->blob "secret"))))
     25         (ciphertext (string-append ciphertext (blob->string (cipher-context-final! ctx)))))
     26    (cipher-context-reset! ctx)
     27    (cipher-context-init! ctx aes-128-ecb key iv mode: 'decrypt)
     28    (let* ((plaintext (blob->string (cipher-context-update! ctx (string->blob ciphertext))))
     29           (plaintext (string-append (blob->string (cipher-context-final! ctx)))))
     30      (test "Low level API roundtrip" plaintext "secret"))))
     31
     32(test "Port API roundtrip"
     33      "secret"
     34      (let* ((key (string->blob "YELLOW SUBMARINE"))
     35             (iv #f)
     36             (ciphertext
     37              (call-with-output-string
     38               (lambda (out)
     39                 (let ((out (open-cipher-port out aes-128-ecb key iv mode: 'encrypt)))
     40                   (display "secret" out)
     41                   (close-output-port out))))))
     42        (call-with-output-string
     43         (lambda (out)
     44           (let ((out (open-cipher-port out aes-128-ecb key iv mode: 'decrypt)))
     45             (display ciphertext out)
     46             (close-output-port out))))))
    2147
    2248(define (encrypt-string cipher plaintext key iv #!rest opts)
  • release/5/openssl/trunk/tests/digest-test.scm

    r40227 r40228  
    2727  (digest-context-free! ctx))
    2828
     29(test "Port API works"
     30      "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e"
     31      (call-with-output-string
     32       (lambda (out)
     33         (let ((out (open-digest-port out md5)))
     34           (display "" out)
     35           (close-output-port out)))))
     36
    2937(test "MD5 hash (empty)" "\xd4\x1d\x8c\xd9\x8f\x00\xb2\x04\xe9\x80\x09\x98\xec\xf8\x42\x7e" (string-digest md5 ""))
    3038(test "MD5 hash (short)" "\x90\x01\x50\x98\x3c\xd2\x4f\xb0\xd6\x96\x3f\x7d\x28\xe1\x7f\x72" (string-digest md5 "abc"))
Note: See TracChangeset for help on using the changeset viewer.