Add crypto bindings: C shim, R6RS library, and tests
ober
0f1e6c015e19ef44d444b9fc0e5f4a66a0b9d56c
new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,17 @@ +CC = gcc +CFLAGS = -shared -fPIC -O2 +LIBS = -lcrypto +SCHEME = scheme + +.PHONY: all clean test + +all: chez_crypto_shim.so + +chez_crypto_shim.so: chez_crypto_shim.c + $(CC) $(CFLAGS) -o $@ $< $(LIBS) + +test: chez_crypto_shim.so + LD_LIBRARY_PATH=. $(SCHEME) --libdirs src --script tests/crypto-test.ss + +clean: + rm -f chez_crypto_shim.so new file mode 100644 --- /dev/null +++ b/chez_crypto_shim.c @@ -0,0 +1,280 @@ +/* chez_crypto_shim.c — OpenSSL libcrypto wrapper for Chez Scheme FFI */ + +#include <openssl/evp.h> +#include <openssl/hmac.h> +#include <openssl/bn.h> +#include <openssl/dh.h> +#include <openssl/rand.h> +#include <openssl/err.h> +#include <openssl/kdf.h> +#include <stdlib.h> +#include <string.h> + +/* ---- Error handling ---- */ + +int chez_crypto_err_get(char *buf, int buflen) { + unsigned long e = ERR_get_error(); + if (e == 0) { + buf[0] = 0; + return 0; + } + ERR_error_string_n(e, buf, buflen); + return 1; +} + +/* ---- Random ---- */ + +int chez_rand_bytes(unsigned char *buf, int n) { + return RAND_bytes(buf, n); +} + +/* ---- Digest (Hash) ---- */ + +void *chez_digest_ctx_new(void) { + return EVP_MD_CTX_new(); +} + +void chez_digest_ctx_free(void *ctx) { + EVP_MD_CTX_free((EVP_MD_CTX *)ctx); +} + +int chez_digest_init(void *ctx, const char *algo) { + const EVP_MD *md = EVP_get_digestbyname(algo); + if (!md) return -1; + return EVP_DigestInit_ex((EVP_MD_CTX *)ctx, md, NULL) == 1 ? 0 : -2; +} + +int chez_digest_update(void *ctx, const unsigned char *data, int len) { + return EVP_DigestUpdate((EVP_MD_CTX *)ctx, data, len) == 1 ? 0 : -1; +} + +int chez_digest_final(void *ctx, unsigned char *out, int *outlen) { + unsigned int len = 0; + int rc = EVP_DigestFinal_ex((EVP_MD_CTX *)ctx, out, &len); + *outlen = (int)len; + return rc == 1 ? 0 : -1; +} + +int chez_digest_size(const char *algo) { + const EVP_MD *md = EVP_get_digestbyname(algo); + if (!md) return -1; + return EVP_MD_size(md); +} + +/* One-shot digest */ +int chez_digest(const char *algo, const unsigned char *data, int datalen, + unsigned char *out, int *outlen) { + const EVP_MD *md = EVP_get_digestbyname(algo); + if (!md) return -1; + EVP_MD_CTX *ctx = EVP_MD_CTX_new(); + if (!ctx) return -2; + unsigned int len = 0; + int rc = -3; + if (EVP_DigestInit_ex(ctx, md, NULL) == 1 && + EVP_DigestUpdate(ctx, data, datalen) == 1 && + EVP_DigestFinal_ex(ctx, out, &len) == 1) { + rc = 0; + } + *outlen = (int)len; + EVP_MD_CTX_free(ctx); + return rc; +} + +/* ---- HMAC ---- */ + +int chez_hmac(const char *algo, const unsigned char *key, int keylen, + const unsigned char *data, int datalen, + unsigned char *out, int *outlen) { + const EVP_MD *md = EVP_get_digestbyname(algo); + if (!md) return -1; + unsigned int len = 0; + unsigned char *result = HMAC(md, key, keylen, data, datalen, out, &len); + *outlen = (int)len; + return result ? 0 : -2; +} + +/* ---- Cipher (Symmetric Encryption) ---- */ + +void *chez_cipher_ctx_new(void) { + return EVP_CIPHER_CTX_new(); +} + +void chez_cipher_ctx_free(void *ctx) { + EVP_CIPHER_CTX_free((EVP_CIPHER_CTX *)ctx); +} + +int chez_cipher_key_length(const char *algo) { + const EVP_CIPHER *c = EVP_get_cipherbyname(algo); + if (!c) return -1; + return EVP_CIPHER_key_length(c); +} + +int chez_cipher_iv_length(const char *algo) { + const EVP_CIPHER *c = EVP_get_cipherbyname(algo); + if (!c) return -1; + return EVP_CIPHER_iv_length(c); +} + +int chez_cipher_block_size(const char *algo) { + const EVP_CIPHER *c = EVP_get_cipherbyname(algo); + if (!c) return -1; + return EVP_CIPHER_block_size(c); +} + +int chez_encrypt_init(void *ctx, const char *algo, + const unsigned char *key, const unsigned char *iv) { + const EVP_CIPHER *c = EVP_get_cipherbyname(algo); + if (!c) return -1; + return EVP_EncryptInit_ex((EVP_CIPHER_CTX *)ctx, c, NULL, key, iv) == 1 ? 0 : -2; +} + +int chez_encrypt_update(void *ctx, const unsigned char *in, int inlen, + unsigned char *out, int *outlen) { + return EVP_EncryptUpdate((EVP_CIPHER_CTX *)ctx, out, outlen, in, inlen) == 1 ? 0 : -1; +} + +int chez_encrypt_final(void *ctx, unsigned char *out, int *outlen) { + return EVP_EncryptFinal_ex((EVP_CIPHER_CTX *)ctx, out, outlen) == 1 ? 0 : -1; +} + +int chez_decrypt_init(void *ctx, const char *algo, + const unsigned char *key, const unsigned char *iv) { + const EVP_CIPHER *c = EVP_get_cipherbyname(algo); + if (!c) return -1; + return EVP_DecryptInit_ex((EVP_CIPHER_CTX *)ctx, c, NULL, key, iv) == 1 ? 0 : -2; +} + +int chez_decrypt_update(void *ctx, const unsigned char *in, int inlen, + unsigned char *out, int *outlen) { + return EVP_DecryptUpdate((EVP_CIPHER_CTX *)ctx, out, outlen, in, inlen) == 1 ? 0 : -1; +} + +int chez_decrypt_final(void *ctx, unsigned char *out, int *outlen) { + return EVP_DecryptFinal_ex((EVP_CIPHER_CTX *)ctx, out, outlen) == 1 ? 0 : -1; +} + +/* One-shot encrypt */ +int chez_encrypt(const char *algo, const unsigned char *key, const unsigned char *iv, + const unsigned char *in, int inlen, + unsigned char *out, int *outlen) { + EVP_CIPHER_CTX *ctx = EVP_CIPHER_CTX_new(); + if (!ctx) return -1; + int len1 = 0, len2 = 0; + int rc = -2; + if (chez_encrypt_init(ctx, algo, key, iv) == 0 && + EVP_EncryptUpdate(ctx, out, &len1, in, inlen) == 1 && + EVP_EncryptFinal_ex(ctx, out + len1, &len2) == 1) { + *outlen = len1 + len2; + rc = 0; + } + EVP_CIPHER_CTX_free(ctx); + return rc; +} + +/* One-shot decrypt */ +int chez_decrypt(const char *algo, const unsigned char *key, const unsigned char *iv, + const unsigned char *in, int inlen, + unsigned char *out, int *outlen) { + EVP_CIPHER_CTX *ctx = EVP_CIPHER_CTX_new(); + if (!ctx) return -1; + int len1 = 0, len2 = 0; + int rc = -2; + if (chez_decrypt_init(ctx, algo, key, iv) == 0 && + EVP_DecryptUpdate(ctx, out, &len1, in, inlen) == 1 && + EVP_DecryptFinal_ex(ctx, out + len1, &len2) == 1) { + *outlen = len1 + len2; + rc = 0; + } + EVP_CIPHER_CTX_free(ctx); + return rc; +} + +/* ---- Ed25519 Sign/Verify ---- */ + +int chez_ed25519_keygen(unsigned char *privkey, int *privlen, + unsigned char *pubkey, int *publen) { + EVP_PKEY_CTX *pctx = EVP_PKEY_CTX_new_id(EVP_PKEY_ED25519, NULL); + if (!pctx) return -1; + EVP_PKEY *pkey = NULL; + int rc = -2; + if (EVP_PKEY_keygen_init(pctx) == 1 && + EVP_PKEY_keygen(pctx, &pkey) == 1) { + size_t pl = 64, sl = 32; + if (EVP_PKEY_get_raw_private_key(pkey, privkey, &pl) == 1 && + EVP_PKEY_get_raw_public_key(pkey, pubkey, &sl) == 1) { + *privlen = (int)pl; + *publen = (int)sl; + rc = 0; + } + } + if (pkey) EVP_PKEY_free(pkey); + EVP_PKEY_CTX_free(pctx); + return rc; +} + +int chez_ed25519_sign(const unsigned char *privkey, int privlen, + const unsigned char *msg, int msglen, + unsigned char *sig, int *siglen) { + EVP_PKEY *pkey = EVP_PKEY_new_raw_private_key(EVP_PKEY_ED25519, NULL, privkey, privlen); + if (!pkey) return -1; + EVP_MD_CTX *mctx = EVP_MD_CTX_new(); + int rc = -2; + size_t sl = 64; + if (EVP_DigestSignInit(mctx, NULL, NULL, NULL, pkey) == 1 && + EVP_DigestSign(mctx, sig, &sl, msg, msglen) == 1) { + *siglen = (int)sl; + rc = 0; + } + EVP_MD_CTX_free(mctx); + EVP_PKEY_free(pkey); + return rc; +} + +int chez_ed25519_verify(const unsigned char *pubkey, int publen, + const unsigned char *msg, int msglen, + const unsigned char *sig, int siglen) { + EVP_PKEY *pkey = EVP_PKEY_new_raw_public_key(EVP_PKEY_ED25519, NULL, pubkey, publen); + if (!pkey) return -1; + EVP_MD_CTX *mctx = EVP_MD_CTX_new(); + int rc = EVP_DigestVerifyInit(mctx, NULL, NULL, NULL, pkey) == 1 && + EVP_DigestVerify(mctx, sig, siglen, msg, msglen) == 1 ? 1 : 0; + EVP_MD_CTX_free(mctx); + EVP_PKEY_free(pkey); + return rc; +} + +/* ---- BN (Big Number) ---- */ + +int chez_bn_bytes(const unsigned char *bin, int binlen) { + BIGNUM *bn = BN_bin2bn(bin, binlen, NULL); + if (!bn) return -1; + int n = BN_num_bytes(bn); + BN_free(bn); + return n; +} + +/* ---- DH (Diffie-Hellman) ---- */ +/* Note: DH is deprecated in OpenSSL 3.x — included for API compat */ + +/* ---- Scrypt KDF ---- */ + +int chez_scrypt(const unsigned char *pass, int passlen, + const unsigned char *salt, int saltlen, + unsigned long long N, int r, int p, + unsigned char *out, int outlen) { + EVP_PKEY_CTX *pctx = EVP_PKEY_CTX_new_id(EVP_PKEY_SCRYPT, NULL); + if (!pctx) return -1; + int rc = -2; + size_t derived_len = outlen; + if (EVP_PKEY_derive_init(pctx) == 1 && + EVP_PKEY_CTX_set1_pbe_pass(pctx, (const char *)pass, passlen) == 1 && + EVP_PKEY_CTX_set1_scrypt_salt(pctx, salt, saltlen) == 1 && + EVP_PKEY_CTX_set_scrypt_N(pctx, N) == 1 && + EVP_PKEY_CTX_set_scrypt_r(pctx, r) == 1 && + EVP_PKEY_CTX_set_scrypt_p(pctx, p) == 1 && + EVP_PKEY_derive(pctx, out, &derived_len) == 1) { + rc = (int)derived_len; + } + EVP_PKEY_CTX_free(pctx); + return rc; +} new file mode 100644 --- /dev/null +++ b/src/chez-crypto.sls @@ -0,0 +1,286 @@ +#!chezscheme +;;; chez-crypto — OpenSSL libcrypto for Chez Scheme + +(library (chez-crypto) + (export + ;; Random + random-bytes random-bytes! + ;; Digest (Hash) + digest digest-size + md5 sha1 sha224 sha256 sha384 sha512 + make-digest-ctx free-digest-ctx + digest-init! digest-update! digest-final! + ;; HMAC + hmac hmac-md5 hmac-sha1 hmac-sha256 hmac-sha384 hmac-sha512 + ;; Cipher (Symmetric) + encrypt decrypt + cipher-key-length cipher-iv-length cipher-block-size + make-cipher-ctx free-cipher-ctx + encrypt-init! encrypt-update! encrypt-final! + decrypt-init! decrypt-update! decrypt-final! + ;; Public Key — Ed25519 + ed25519-keygen ed25519-sign ed25519-verify + ;; KDF + scrypt + ;; Error + crypto-error-string) + + (import (chezscheme)) + + ;; Load shared objects + (define _l1 (load-shared-object "libcrypto.so")) + (define _l2 (load-shared-object "chez_crypto_shim.so")) + + ;; ---- FFI bindings ---- + (define c-err-get (foreign-procedure "chez_crypto_err_get" (u8* int) int)) + (define c-rand-bytes (foreign-procedure "chez_rand_bytes" (u8* int) int)) + (define c-digest (foreign-procedure "chez_digest" (string u8* int u8* u8*) int)) + (define c-digest-size (foreign-procedure "chez_digest_size" (string) int)) + (define c-digest-ctx-new (foreign-procedure "chez_digest_ctx_new" () void*)) + (define c-digest-ctx-free (foreign-procedure "chez_digest_ctx_free" (void*) void)) + (define c-digest-init (foreign-procedure "chez_digest_init" (void* string) int)) + (define c-digest-update (foreign-procedure "chez_digest_update" (void* u8* int) int)) + (define c-digest-final (foreign-procedure "chez_digest_final" (void* u8* u8*) int)) + (define c-hmac (foreign-procedure "chez_hmac" (string u8* int u8* int u8* u8*) int)) + (define c-cipher-ctx-new (foreign-procedure "chez_cipher_ctx_new" () void*)) + (define c-cipher-ctx-free (foreign-procedure "chez_cipher_ctx_free" (void*) void)) + (define c-cipher-key-length (foreign-procedure "chez_cipher_key_length" (string) int)) + (define c-cipher-iv-length (foreign-procedure "chez_cipher_iv_length" (string) int)) + (define c-cipher-block-size (foreign-procedure "chez_cipher_block_size" (string) int)) + (define c-encrypt-init (foreign-procedure "chez_encrypt_init" (void* string u8* u8*) int)) + (define c-encrypt-update (foreign-procedure "chez_encrypt_update" (void* u8* int u8* u8*) int)) + (define c-encrypt-final (foreign-procedure "chez_encrypt_final" (void* u8* u8*) int)) + (define c-decrypt-init (foreign-procedure "chez_decrypt_init" (void* string u8* u8*) int)) + (define c-decrypt-update (foreign-procedure "chez_decrypt_update" (void* u8* int u8* u8*) int)) + (define c-decrypt-final (foreign-procedure "chez_decrypt_final" (void* u8* u8*) int)) + (define c-encrypt (foreign-procedure "chez_encrypt" (string u8* u8* u8* int u8* u8*) int)) + (define c-decrypt (foreign-procedure "chez_decrypt" (string u8* u8* u8* int u8* u8*) int)) + (define c-ed25519-keygen (foreign-procedure "chez_ed25519_keygen" (u8* u8* u8* u8*) int)) + (define c-ed25519-sign (foreign-procedure "chez_ed25519_sign" (u8* int u8* int u8* u8*) int)) + (define c-ed25519-verify (foreign-procedure "chez_ed25519_verify" (u8* int u8* int u8* int) int)) + (define c-scrypt (foreign-procedure "chez_scrypt" (u8* int u8* int unsigned-64 int int u8* int) int)) + + ;; ---- Helpers ---- + (define (check-rc who rc) + (when (< rc 0) + (error who (string-append "crypto error (rc=" (number->string rc) ")")))) + + (define (as-bytes x) + (if (string? x) (string->utf8 x) x)) + + (define (int-ref bv) + (bytevector-s32-native-ref bv 0)) + + (define (make-int-buf) + (make-bytevector 4 0)) + + ;; ---- Error ---- + (define (crypto-error-string) + (let ([buf (make-bytevector 256 0)]) + (if (= (c-err-get buf 256) 1) + (let loop ([i 0]) + (if (or (= i 256) (= (bytevector-u8-ref buf i) 0)) + (utf8->string (let ([r (make-bytevector i)]) + (bytevector-copy! buf 0 r 0 i) r)) + (loop (+ i 1)))) + #f))) + + ;; ---- Random ---- + (define (random-bytes n) + (let ([bv (make-bytevector n)]) + (random-bytes! bv) + bv)) + + (define (random-bytes! bv) + (let ([rc (c-rand-bytes bv (bytevector-length bv))]) + (unless (= rc 1) (error 'random-bytes! "RAND_bytes failed")))) + + ;; ---- Digest ---- + (define (digest-size algo) + (let ([n (c-digest-size algo)]) + (check-rc 'digest-size n) + n)) + + (define (digest algo data) + (let* ([data (as-bytes data)] + [out (make-bytevector 64 0)] + [lenp (make-int-buf)] + [rc (c-digest algo data (bytevector-length data) out lenp)]) + (check-rc 'digest rc) + (let ([len (int-ref lenp)] + [result (make-bytevector (int-ref lenp))]) + (bytevector-copy! out 0 result 0 len) + result))) + + (define (md5 data) (digest "md5" data)) + (define (sha1 data) (digest "sha1" data)) + (define (sha224 data) (digest "sha224" data)) + (define (sha256 data) (digest "sha256" data)) + (define (sha384 data) (digest "sha384" data)) + (define (sha512 data) (digest "sha512" data)) + + ;; Streaming digest + (define (make-digest-ctx) (c-digest-ctx-new)) + (define (free-digest-ctx ctx) (c-digest-ctx-free ctx)) + + (define (digest-init! ctx algo) + (check-rc 'digest-init! (c-digest-init ctx algo))) + + (define (digest-update! ctx data) + (let ([data (as-bytes data)]) + (check-rc 'digest-update! (c-digest-update ctx data (bytevector-length data))))) + + (define (digest-final! ctx) + (let ([out (make-bytevector 64 0)] + [lenp (make-int-buf)]) + (check-rc 'digest-final! (c-digest-final ctx out lenp)) + (let ([len (int-ref lenp)] + [result (make-bytevector (int-ref lenp))]) + (bytevector-copy! out 0 result 0 len) + result))) + + ;; ---- HMAC ---- + (define (hmac algo key data) + (let* ([key (as-bytes key)] + [data (as-bytes data)] + [out (make-bytevector 64 0)] + [lenp (make-int-buf)] + [rc (c-hmac algo key (bytevector-length key) + data (bytevector-length data) out lenp)]) + (check-rc 'hmac rc) + (let ([len (int-ref lenp)] + [result (make-bytevector (int-ref lenp))]) + (bytevector-copy! out 0 result 0 len) + result))) + + (define (hmac-md5 key data) (hmac "md5" key data)) + (define (hmac-sha1 key data) (hmac "sha1" key data)) + (define (hmac-sha256 key data) (hmac "sha256" key data)) + (define (hmac-sha384 key data) (hmac "sha384" key data)) + (define (hmac-sha512 key data) (hmac "sha512" key data)) + + ;; ---- Cipher ---- + (define (cipher-key-length algo) (c-cipher-key-length algo)) + (define (cipher-iv-length algo) (c-cipher-iv-length algo)) + (define (cipher-block-size algo) (c-cipher-block-size algo)) + + (define (make-cipher-ctx) (c-cipher-ctx-new)) + (define (free-cipher-ctx ctx) (c-cipher-ctx-free ctx)) + + (define (encrypt-init! ctx algo key iv) + (check-rc 'encrypt-init! (c-encrypt-init ctx algo key iv))) + + (define (encrypt-update! ctx plaintext) + (let* ([inlen (bytevector-length plaintext)] + [out (make-bytevector (+ inlen 64) 0)] + [lenp (make-int-buf)]) + (check-rc 'encrypt-update! (c-encrypt-update ctx plaintext inlen out lenp)) + (let ([len (int-ref lenp)] + [result (make-bytevector (int-ref lenp))]) + (bytevector-copy! out 0 result 0 len) + result))) + + (define (encrypt-final! ctx) + (let ([out (make-bytevector 64 0)] + [lenp (make-int-buf)]) + (check-rc 'encrypt-final! (c-encrypt-final ctx out lenp)) + (let ([len (int-ref lenp)] + [result (make-bytevector (int-ref lenp))]) + (bytevector-copy! out 0 result 0 len) + result))) + + (define (decrypt-init! ctx algo key iv) + (check-rc 'decrypt-init! (c-decrypt-init ctx algo key iv))) + + (define (decrypt-update! ctx ciphertext) + (let* ([inlen (bytevector-length ciphertext)] + [out (make-bytevector (+ inlen 64) 0)] + [lenp (make-int-buf)]) + (check-rc 'decrypt-update! (c-decrypt-update ctx ciphertext inlen out lenp)) + (let ([len (int-ref lenp)] + [result (make-bytevector (int-ref lenp))]) + (bytevector-copy! out 0 result 0 len) + result))) + + (define (decrypt-final! ctx) + (let ([out (make-bytevector 64 0)] + [lenp (make-int-buf)]) + (check-rc 'decrypt-final! (c-decrypt-final ctx out lenp)) + (let ([len (int-ref lenp)] + [result (make-bytevector (int-ref lenp))]) + (bytevector-copy! out 0 result 0 len) + result))) + + ;; One-shot encrypt/decrypt + (define (encrypt algo key iv plaintext) + (let* ([plaintext (as-bytes plaintext)] + [inlen (bytevector-length plaintext)] + [out (make-bytevector (+ inlen 64) 0)] + [lenp (make-int-buf)] + [rc (c-encrypt algo key iv plaintext inlen out lenp)]) + (check-rc 'encrypt rc) + (let ([len (int-ref lenp)] + [result (make-bytevector (int-ref lenp))]) + (bytevector-copy! out 0 result 0 len) + result))) + + (define (decrypt algo key iv ciphertext) + (let* ([inlen (bytevector-length ciphertext)] + [out (make-bytevector (+ inlen 64) 0)] + [lenp (make-int-buf)] + [rc (c-decrypt algo key iv ciphertext inlen out lenp)]) + (check-rc 'decrypt rc) + (let ([len (int-ref lenp)] + [result (make-bytevector (int-ref lenp))]) + (bytevector-copy! out 0 result 0 len) + result))) + + ;; ---- Ed25519 ---- + (define (ed25519-keygen) + (let ([priv (make-bytevector 64 0)] + [pub (make-bytevector 32 0)] + [privlen (make-int-buf)] + [publen (make-int-buf)]) + (let ([rc (c-ed25519-keygen priv privlen pub publen)]) + (check-rc 'ed25519-keygen rc) + (let ([pl (int-ref privlen)] + [sl (int-ref publen)]) + (let ([priv-out (make-bytevector pl)] + [pub-out (make-bytevector sl)]) + (bytevector-copy! priv 0 priv-out 0 pl) + (bytevector-copy! pub 0 pub-out 0 sl) + (values priv-out pub-out)))))) + + (define (ed25519-sign privkey message) + (let* ([msg (as-bytes message)] + [sig (make-bytevector 64 0)] + [siglen (make-int-buf)] + [rc (c-ed25519-sign privkey (bytevector-length privkey) + msg (bytevector-length msg) sig siglen)]) + (check-rc 'ed25519-sign rc) + (let ([sl (int-ref siglen)] + [result (make-bytevector (int-ref siglen))]) + (bytevector-copy! sig 0 result 0 sl) + result))) + + (define (ed25519-verify pubkey message signature) + (let* ([msg (as-bytes message)]) + (= 1 (c-ed25519-verify pubkey (bytevector-length pubkey) + msg (bytevector-length msg) + signature (bytevector-length signature))))) + + ;; ---- Scrypt KDF ---- + (define scrypt + (case-lambda + [(pass salt size) (scrypt pass salt size 1024 8 16)] + [(pass salt size N r p) + (let* ([pass (as-bytes pass)] + [salt (as-bytes salt)] + [out (make-bytevector size 0)] + [rc (c-scrypt pass (bytevector-length pass) + salt (bytevector-length salt) + N r p out size)]) + (check-rc 'scrypt rc) + out)])) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/crypto-test.ss @@ -0,0 +1,129 @@ +#!chezscheme +;;; crypto-test.ss — Tests for chez-crypto + +(import (chezscheme) (chez-crypto)) + +(define pass-count 0) +(define fail-count 0) + +(define-syntax chk + (syntax-rules (=>) + [(_ expr => expected) + (let ([result expr] [exp expected]) + (if (equal? result exp) + (set! pass-count (+ pass-count 1)) + (begin (set! fail-count (+ fail-count 1)) + (display "FAIL: ") (write 'expr) + (display " => ") (write result) + (display " expected ") (write exp) (newline))))])) + +(define (bv->hex bv) + (let loop ([i 0] [acc ""]) + (if (= i (bytevector-length bv)) (string-downcase acc) + (loop (+ i 1) + (string-append acc + (let ([b (bytevector-u8-ref bv i)]) + (string-append + (if (< b 16) "0" "") + (number->string b 16)))))))) + +;;; ---- Random ---- +(let ([bv (random-bytes 32)]) + (chk (bytevector-length bv) => 32) + (chk (not (equal? bv (make-bytevector 32 0))) => #t)) + +;;; ---- Digest ---- +(chk (bv->hex (md5 "hello")) => "5d41402abc4b2a76b9719d911017c592") +(chk (bv->hex (sha1 "hello")) => "aaf4c61ddcc5e8a2dabede0f3b482cd9aea9434d") +(chk (bv->hex (sha256 "hello")) => "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824") + +;; Streaming digest +(let ([ctx (make-digest-ctx)]) + (digest-init! ctx "sha256") + (digest-update! ctx "hel") + (digest-update! ctx "lo") + (let ([result (digest-final! ctx)]) + (chk (bv->hex result) => "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824")) + (free-digest-ctx ctx)) + +;; Digest size +(chk (digest-size "md5") => 16) +(chk (digest-size "sha256") => 32) +(chk (digest-size "sha512") => 64) + +;;; ---- HMAC ---- +(let ([h (hmac-sha256 "key" "hello")]) + (chk (= (bytevector-length h) 32) => #t)) + +(let ([h (hmac-md5 "key" "data")]) + (chk (= (bytevector-length h) 16) => #t)) + +;;; ---- Cipher ---- +(chk (cipher-key-length "aes-256-cbc") => 32) +(chk (cipher-iv-length "aes-256-cbc") => 16) +(chk (cipher-block-size "aes-256-cbc") => 16) + +;; One-shot encrypt/decrypt round-trip +(let* ([key (random-bytes 32)] + [iv (random-bytes 16)] + [plain (string->utf8 "Hello, chez-crypto!")] + [cipher (encrypt "aes-256-cbc" key iv plain)] + [decrypted (decrypt "aes-256-cbc" key iv cipher)]) + (chk (equal? plain decrypted) => #t) + (chk (not (equal? plain cipher)) => #t)) + +;; Streaming cipher +(let* ([key (random-bytes 32)] + [iv (random-bytes 16)] + [plain (string->utf8 "streaming encryption test")] + [ctx (make-cipher-ctx)]) + (encrypt-init! ctx "aes-256-cbc" key iv) + (let* ([c1 (encrypt-update! ctx plain)] + [c2 (encrypt-final! ctx)]) + (free-cipher-ctx ctx) + (let ([full-cipher (let ([r (make-bytevector (+ (bytevector-length c1) + (bytevector-length c2)))]) + (bytevector-copy! c1 0 r 0 (bytevector-length c1)) + (bytevector-copy! c2 0 r (bytevector-length c1) (bytevector-length c2)) + r)]) + ;; Decrypt + (let ([dctx (make-cipher-ctx)]) + (decrypt-init! dctx "aes-256-cbc" key iv) + (let* ([d1 (decrypt-update! dctx full-cipher)] + [d2 (decrypt-final! dctx)]) + (free-cipher-ctx dctx) + (let ([decrypted (let ([r (make-bytevector (+ (bytevector-length d1) + (bytevector-length d2)))]) + (bytevector-copy! d1 0 r 0 (bytevector-length d1)) + (bytevector-copy! d2 0 r (bytevector-length d1) (bytevector-length d2)) + r)]) + (chk (equal? plain decrypted) => #t))))))) + +;;; ---- Ed25519 ---- +(let-values ([(priv pub) (ed25519-keygen)]) + (chk (= (bytevector-length pub) 32) => #t) + (chk (> (bytevector-length priv) 0) => #t) + + ;; Sign and verify + (let ([sig (ed25519-sign priv "test message")]) + (chk (= (bytevector-length sig) 64) => #t) + (chk (ed25519-verify pub "test message" sig) => #t) + (chk (ed25519-verify pub "wrong message" sig) => #f))) + +;;; ---- Scrypt ---- +(let ([key (scrypt "password" "salt" 32)]) + (chk (= (bytevector-length key) 32) => #t) + ;; Same inputs should produce same output + (let ([key2 (scrypt "password" "salt" 32)]) + (chk (equal? key key2) => #t)) + ;; Different password → different key + (let ([key3 (scrypt "other" "salt" 32)]) + (chk (not (equal? key key3)) => #t))) + +;;; Summary +(newline) +(display "crypto tests: ") +(display pass-count) (display " passed, ") +(display fail-count) (display " failed") +(newline) +(when (> fail-count 0) (exit 1))