mbedtls_stubs.c

#include <ctype.h>
#include <string.h>
#include <stdio.h>

#ifdef _WIN32
#include <windows.h>
#include <wincrypt.h>
#endif

#ifdef __APPLE__
#include <Security/Security.h>
#endif

#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/fail.h>
#include <caml/callback.h>
#include <caml/custom.h>

#include "mbedtls/debug.h"
#include "mbedtls/error.h"
#include "mbedtls/config.h"
#include "mbedtls/ssl.h"
#include "mbedtls/entropy.h"
#include "mbedtls/ctr_drbg.h"
#include "mbedtls/certs.h"
#include "mbedtls/oid.h"

#define PVoid_val(v) (*((void**) Data_custom_val(v)))

void debug(void* ctx, int debug_level, const char* file_name, int line, const char* message) {
	printf("%s:%i: %s", file_name, line, message);
}

#define Val_none Val_int(0)

static value Val_some(value v) {
    CAMLparam1(v);
    CAMLlocal1(some);
    some = caml_alloc(1, 0);
    Store_field(some, 0, v);
    CAMLreturn(some);
}

CAMLprim value ml_mbedtls_strerror(value code) {
	CAMLparam1(code);
	CAMLlocal1(r);
	char buf[128];
	mbedtls_strerror(Int_val(code), buf, sizeof(buf));
	r = caml_copy_string(buf);
	CAMLreturn(r);
}

// CtrDrbg

#define CtrDrbg_val(v) (*((mbedtls_ctr_drbg_context**) Data_custom_val(v)))

static void ml_mbedtls_ctr_drbg_finalize(value v) {
	mbedtls_ctr_drbg_context* ctr_drbg = CtrDrbg_val(v);
	if (ctr_drbg != NULL) {
		mbedtls_ctr_drbg_free(ctr_drbg);
	}
}

static struct custom_operations ctr_drbg_ops = {
	.identifier  = "ml_ctr_drbg",
	.finalize    = ml_mbedtls_ctr_drbg_finalize,
	.compare     = custom_compare_default,
	.hash        = custom_hash_default,
	.serialize   = custom_serialize_default,
	.deserialize = custom_deserialize_default,
};

CAMLprim value ml_mbedtls_ctr_drbg_init(void) {
	CAMLparam0();
	CAMLlocal1(obj);
	obj = caml_alloc_custom(&ctr_drbg_ops, sizeof(mbedtls_ctr_drbg_context*), 0, 1);
	mbedtls_ctr_drbg_context* ctr_drbg = malloc(sizeof(mbedtls_ctr_drbg_context));
	mbedtls_ctr_drbg_init(ctr_drbg);
	CtrDrbg_val(obj) = ctr_drbg;
	CAMLreturn(obj);
}

CAMLprim value ml_mbedtls_ctr_drbg_random(value p_rng, value output, value output_len) {
	CAMLparam3(p_rng, output, output_len);
	CAMLreturn(Val_int(mbedtls_ctr_drbg_random(CtrDrbg_val(p_rng), String_val(output), Int_val(output_len))));
}

CAMLprim value ml_mbedtls_ctr_drbg_seed(value ctx, value p_entropy, value custom) {
	CAMLparam2(ctx, custom);
	CAMLreturn(Val_int(mbedtls_ctr_drbg_seed(CtrDrbg_val(ctx), mbedtls_entropy_func, PVoid_val(p_entropy), NULL, 0)));
}

// Entropy

#define Entropy_val(v) (*((mbedtls_entropy_context**) Data_custom_val(v)))

static void ml_mbedtls_entropy_finalize(value v) {
	mbedtls_entropy_context* entropy = Entropy_val(v);
	if (entropy != NULL) {
		mbedtls_entropy_free(entropy);
	}
}

static struct custom_operations entropy_ops = {
	.identifier  = "ml_entropy",
	.finalize    = ml_mbedtls_entropy_finalize,
	.compare     = custom_compare_default,
	.hash        = custom_hash_default,
	.serialize   = custom_serialize_default,
	.deserialize = custom_deserialize_default,
};

CAMLprim value ml_mbedtls_entropy_init(void) {
	CAMLparam0();
	CAMLlocal1(obj);
	obj = caml_alloc_custom(&entropy_ops, sizeof(mbedtls_entropy_context*), 0, 1);
	mbedtls_entropy_context* entropy = malloc(sizeof(mbedtls_entropy_context));
	mbedtls_entropy_init(entropy);
	Entropy_val(obj) = entropy;
	CAMLreturn(obj);
}

CAMLprim value ml_mbedtls_entropy_func(value data, value output, value len) {
	CAMLparam3(data, output, len);
	CAMLreturn(Val_int(mbedtls_entropy_func(PVoid_val(data), String_val(output), Int_val(len))));
}

// Certificate

#define X509Crt_val(v) (*((mbedtls_x509_crt**) Data_custom_val(v)))

static void ml_mbedtls_x509_crt_finalize(value v) {
	mbedtls_x509_crt* x509_crt = X509Crt_val(v);
	if (x509_crt != NULL) {
		mbedtls_x509_crt_free(x509_crt);
	}
}

static struct custom_operations x509_crt_ops = {
	.identifier  = "ml_x509_crt",
	.finalize    = ml_mbedtls_x509_crt_finalize,
	.compare     = custom_compare_default,
	.hash        = custom_hash_default,
	.serialize   = custom_serialize_default,
	.deserialize = custom_deserialize_default,
};

CAMLprim value ml_mbedtls_x509_crt_init(void) {
	CAMLparam0();
	CAMLlocal1(obj);
	obj = caml_alloc_custom(&x509_crt_ops, sizeof(mbedtls_x509_crt*), 0, 1);
	mbedtls_x509_crt* x509_crt = malloc(sizeof(mbedtls_x509_crt));
	mbedtls_x509_crt_init(x509_crt);
	X509Crt_val(obj) = x509_crt;
	CAMLreturn(obj);
}

CAMLprim value ml_mbedtls_x509_next(value chain) {
	CAMLparam1(chain);
	CAMLlocal2(r, obj);
	mbedtls_x509_crt* cert = X509Crt_val(chain);
	if (cert->next == NULL) {
		CAMLreturn(Val_none);
	}
	obj = caml_alloc_custom(&x509_crt_ops, sizeof(mbedtls_x509_crt*), 0, 1);
	X509Crt_val(obj) = cert->next;
	CAMLreturn(Val_some(obj));
}

CAMLprim value ml_mbedtls_x509_crt_parse(value chain, value bytes) {
	CAMLparam2(chain, bytes);
	const char* buf = String_val(bytes);
	int len = caml_string_length(bytes);
	CAMLreturn(Val_int(mbedtls_x509_crt_parse(X509Crt_val(chain), buf, len + 1)));
}

CAMLprim value ml_mbedtls_x509_crt_parse_file(value chain, value path) {
	CAMLparam2(chain, path);
	CAMLreturn(Val_int(mbedtls_x509_crt_parse_file(X509Crt_val(chain), String_val(path))));
}

CAMLprim value ml_mbedtls_x509_crt_parse_path(value chain, value path) {
	CAMLparam2(chain, path);
	CAMLreturn(Val_int(mbedtls_x509_crt_parse_path(X509Crt_val(chain), String_val(path))));
}

// Certificate Haxe API

value caml_string_of_asn1_buf(mbedtls_asn1_buf* dat) {
	CAMLparam0();
	CAMLlocal1(s);
	s = caml_alloc_string(dat->len);
	memcpy(String_val(s), dat->p, dat->len);
	CAMLreturn(s);
}

CAMLprim value hx_cert_get_alt_names(value chain) {
	CAMLparam1(chain);
	CAMLlocal1(obj);
	mbedtls_x509_crt* cert = X509Crt_val(chain);
	if (cert->ext_types & MBEDTLS_X509_EXT_SUBJECT_ALT_NAME == 0 || &cert->subject_alt_names == NULL) {
		obj = Atom(0);
	} else {
		mbedtls_asn1_sequence* cur = &cert->subject_alt_names;
		int i = 0;
		while (cur != NULL) {
			++i;
			cur = cur->next;
		}
		obj = caml_alloc(i, 0);
		cur = &cert->subject_alt_names;
		i = 0;
		while (cur != NULL) {
			Store_field(obj, i, caml_string_of_asn1_buf(&cur->buf));
			++i;
			cur = cur->next;
		}
	}
	CAMLreturn(obj);
}

CAMLprim value hx_cert_get_subject(value chain, value objname) {
	CAMLparam2(chain, objname);
	mbedtls_x509_name *obj;
	mbedtls_x509_crt* cert = X509Crt_val(chain);
	const char *oname, *rname;
	obj = &cert->subject;
	rname = String_val(objname);
	while (obj != NULL) {
		int r = mbedtls_oid_get_attr_short_name(&obj->oid, &oname);
		if (r == 0 && strcmp(oname, rname) == 0) {
			CAMLreturn(Val_some(caml_string_of_asn1_buf(&obj->val)));
		}
		obj = obj->next;
	}
	CAMLreturn(Val_none);
}

CAMLprim value hx_cert_get_issuer(value chain, value objname) {
	CAMLparam2(chain, objname);
	mbedtls_x509_name *obj;
	mbedtls_x509_crt* cert = X509Crt_val(chain);
	int r;
	const char *oname, *rname;
	obj = &cert->issuer;
	rname = String_val(objname);
	while (obj != NULL) {
		r = mbedtls_oid_get_attr_short_name(&obj->oid, &oname);
		if (r == 0 && strcmp(oname, rname) == 0) {
			CAMLreturn(Val_some(caml_string_of_asn1_buf(&obj->val)));
		}
		obj = obj->next;
	}
	CAMLreturn(Val_none);
}

time_t time_to_time_t(mbedtls_x509_time* t) {
	struct tm info;
	info.tm_year = t->year - 1900;
	info.tm_mon = t->mon - 1;
	info.tm_mday = t->day;
	info.tm_hour = t->hour;
	info.tm_min = t->min;
	info.tm_sec = t->sec;
	return mktime(&info);
}

CAMLprim value hx_cert_get_notafter(value chain) {
	CAMLparam1(chain);
	mbedtls_x509_crt* cert = X509Crt_val(chain);
	mbedtls_x509_time *t = &cert->valid_to;
	time_t time = time_to_time_t(t);
	CAMLreturn(caml_copy_double((double)time));
}

CAMLprim value hx_cert_get_notbefore(value chain) {
	CAMLparam1(chain);
	mbedtls_x509_crt* cert = X509Crt_val(chain);
	mbedtls_x509_time *t = &cert->valid_from;
	time_t time = time_to_time_t(t);
	CAMLreturn(caml_copy_double((double)time));
}

// Config

#define Config_val(v) (*((mbedtls_ssl_config**) Data_custom_val(v)))

static void ml_mbedtls_ssl_config_finalize(value v) {
	mbedtls_ssl_config* ssl_config = Config_val(v);
	if (ssl_config != NULL) {
		mbedtls_ssl_config_free(ssl_config);
	}
}

static struct custom_operations ssl_config_ops = {
	.identifier  = "ml_ssl_config",
	.finalize    = ml_mbedtls_ssl_config_finalize,
	.compare     = custom_compare_default,
	.hash        = custom_hash_default,
	.serialize   = custom_serialize_default,
	.deserialize = custom_deserialize_default,
};

CAMLprim value ml_mbedtls_ssl_config_init(void) {
	CAMLparam0();
	CAMLlocal1(obj);
	obj = caml_alloc_custom(&ssl_config_ops, sizeof(mbedtls_ssl_config*), 0, 1);
	mbedtls_ssl_config* ssl_config = malloc(sizeof(mbedtls_ssl_config));
	mbedtls_ssl_config_init(ssl_config);
	Config_val(obj) = ssl_config;
	CAMLreturn(obj);
}

CAMLprim value ml_mbedtls_ssl_conf_authmode(value conf, value authmode) {
	CAMLparam2(conf, authmode);
	mbedtls_ssl_conf_authmode(Config_val(conf), Int_val(authmode));
	CAMLreturn(Val_unit);
}

CAMLprim value ml_mbedtls_ssl_conf_ca_chain(value conf, value ca_chain) {
	CAMLparam2(conf, ca_chain);
	mbedtls_ssl_conf_ca_chain(Config_val(conf), X509Crt_val(ca_chain), NULL);
	CAMLreturn(Val_unit);
}

CAMLprim value ml_mbedtls_ssl_config_defaults(value conf, value endpoint, value transport, value preset) {
	CAMLparam4(conf, endpoint, transport, preset);
	CAMLreturn(Val_int(mbedtls_ssl_config_defaults(Config_val(conf), Int_val(endpoint), Int_val(transport), Int_val(preset))));
}

CAMLprim value ml_mbedtls_ssl_conf_rng(value conf, value p_rng) {
	CAMLparam2(conf, p_rng);
	mbedtls_ssl_conf_rng(Config_val(conf), mbedtls_ctr_drbg_random, PVoid_val(p_rng));
	CAMLreturn(Val_unit);
}

// Pk

#define PkContext_val(v) (*((mbedtls_pk_context**) Data_custom_val(v)))

static void ml_mbedtls_pk_context_finalize(value v) {
	mbedtls_pk_context* pk_context = PkContext_val(v);
	if (pk_context != NULL) {
		mbedtls_pk_free(pk_context);
	}
}

static struct custom_operations pk_context_ops = {
	.identifier  = "ml_pk_context",
	.finalize    = ml_mbedtls_pk_context_finalize,
	.compare     = custom_compare_default,
	.hash        = custom_hash_default,
	.serialize   = custom_serialize_default,
	.deserialize = custom_deserialize_default,
};

CAMLprim value ml_mbedtls_pk_init(void) {
	CAMLparam0();
	CAMLlocal1(obj);
	obj = caml_alloc_custom(&pk_context_ops, sizeof(mbedtls_pk_context*), 0, 1);
	mbedtls_pk_context* pk_context = malloc(sizeof(mbedtls_pk_context));
	mbedtls_pk_init(pk_context);
	PkContext_val(obj) = pk_context;
	CAMLreturn(obj);
}

CAMLprim value ml_mbedtls_pk_parse_key(value ctx, value key, value password) {
	CAMLparam3(ctx, key, password);
	const char* pwd = NULL;
	size_t pwdlen = 0;
	if (password != Val_none) {
		pwd = String_val(Field(password, 0));
		pwdlen = caml_string_length(Field(password, 0));
	}
	CAMLreturn(mbedtls_pk_parse_key(PkContext_val(ctx), String_val(key), caml_string_length(key) + 1, pwd, pwdlen));
}

CAMLprim value ml_mbedtls_pk_parse_keyfile(value ctx, value path, value password) {
	CAMLparam3(ctx, path, password);
	const char* pwd = NULL;
	if (password != Val_none) {
		pwd = String_val(Field(password, 0));
	}
	CAMLreturn(mbedtls_pk_parse_keyfile(PkContext_val(ctx), String_val(path), pwd));
}

CAMLprim value ml_mbedtls_pk_parse_public_key(value ctx, value key) {
	CAMLparam2(ctx, key);
	CAMLreturn(mbedtls_pk_parse_public_key(PkContext_val(ctx), String_val(key), caml_string_length(key) + 1));
}

CAMLprim value ml_mbedtls_pk_parse_public_keyfile(value ctx, value path) {
	CAMLparam2(ctx, path);
	CAMLreturn(mbedtls_pk_parse_public_keyfile(PkContext_val(ctx), String_val(path)));
}

// Ssl

#define SslContext_val(v) (*((mbedtls_ssl_context**) Data_custom_val(v)))

static void ml_mbedtls_ssl_context_finalize(value v) {
	mbedtls_ssl_context* ssl_context = SslContext_val(v);
	if (ssl_context != NULL) {
		mbedtls_ssl_free(ssl_context);
	}
}

static struct custom_operations ssl_context_ops = {
	.identifier  = "ml_ssl_context",
	.finalize    = ml_mbedtls_ssl_context_finalize,
	.compare     = custom_compare_default,
	.hash        = custom_hash_default,
	.serialize   = custom_serialize_default,
	.deserialize = custom_deserialize_default,
};

CAMLprim value ml_mbedtls_ssl_init(void) {
	CAMLparam0();
	CAMLlocal1(obj);
	obj = caml_alloc_custom(&ssl_context_ops, sizeof(mbedtls_ssl_context*), 0, 1);
	mbedtls_ssl_context* ssl_context = malloc(sizeof(mbedtls_ssl_context));
	mbedtls_ssl_init(ssl_context);
	SslContext_val(obj) = ssl_context;
	CAMLreturn(obj);
}

CAMLprim value ml_mbedtls_ssl_get_peer_cert(value ssl) {
	CAMLparam1(ssl);
	CAMLlocal1(obj);
	mbedtls_ssl_context* ssl_context = SslContext_val(ssl);
	mbedtls_x509_crt* crt = (mbedtls_x509_crt*)mbedtls_ssl_get_peer_cert(ssl_context);
	if (crt == NULL) {
		CAMLreturn(Val_none);
	}
	obj = caml_alloc_custom(&x509_crt_ops, sizeof(mbedtls_x509_crt*), 0, 1);
	X509Crt_val(obj) = crt;
	CAMLreturn(Val_some(obj));
}

CAMLprim value ml_mbedtls_ssl_handshake(value ssl) {
	CAMLparam1(ssl);
	CAMLreturn(Val_int(mbedtls_ssl_handshake(SslContext_val(ssl))));
}

CAMLprim value ml_mbedtls_ssl_read(value ssl, value buf, value pos, value len) {
	CAMLparam4(ssl, buf, pos, len);
	CAMLreturn(Val_int(mbedtls_ssl_read(SslContext_val(ssl), String_val(buf) + Int_val(pos), Int_val(len))));
}

static int bio_write_cb(void* ctx, const unsigned char* buf, size_t len) {
	CAMLparam0();
	CAMLlocal3(r, s, vctx);
	vctx = (value)ctx;
	s = caml_alloc_string(len);
	memcpy(String_val(s), buf, len);
	r = caml_callback2(Field(vctx, 1), Field(vctx, 0), s);
	CAMLreturn(Int_val(r));
}

static int bio_read_cb(void* ctx, unsigned char* buf, size_t len) {
	CAMLparam0();
	CAMLlocal3(r, s, vctx);
	vctx = (value)ctx;
	s = caml_alloc_string(len);
	r = caml_callback2(Field(vctx, 2), Field(vctx, 0), s);
	memcpy(buf, String_val(s), len);
	CAMLreturn(Int_val(r));
}

CAMLprim value ml_mbedtls_ssl_set_bio(value ssl, value p_bio, value f_send, value f_recv) {
	CAMLparam4(ssl, p_bio, f_send, f_recv);
	CAMLlocal1(ctx);
	ctx = caml_alloc(3, 0);
	Store_field(ctx, 0, p_bio);
	Store_field(ctx, 1, f_send);
	Store_field(ctx, 2, f_recv);
	mbedtls_ssl_set_bio(SslContext_val(ssl), (void*)ctx, bio_write_cb, bio_read_cb, NULL);
	CAMLreturn(Val_unit);
}

CAMLprim value ml_mbedtls_ssl_set_hostname(value ssl, value hostname) {
	CAMLparam2(ssl, hostname);
	CAMLreturn(Val_int(mbedtls_ssl_set_hostname(SslContext_val(ssl), String_val(hostname))));
}

CAMLprim value ml_mbedtls_ssl_setup(value ssl, value conf) {
	CAMLparam2(ssl, conf);
	CAMLreturn(Val_int(mbedtls_ssl_setup(SslContext_val(ssl), Config_val(conf))));
}

CAMLprim value ml_mbedtls_ssl_write(value ssl, value buf, value pos, value len) {
	CAMLparam4(ssl, buf, pos, len);
	CAMLreturn(Val_int(mbedtls_ssl_write(SslContext_val(ssl), String_val(buf) + Int_val(pos), Int_val(len))));
}

// glue

CAMLprim value hx_cert_load_defaults(value certificate) {
	CAMLparam1(certificate);
	int r = 1;

	mbedtls_x509_crt *chain = X509Crt_val(certificate);

	#ifdef _WIN32
	HCERTSTORE store;
	PCCERT_CONTEXT cert;

	if (store = CertOpenSystemStore(0, "Root")) {
		cert = NULL;
		while (cert = CertEnumCertificatesInStore(store, cert)) {
			r = mbedtls_x509_crt_parse_der(chain, (unsigned char *)cert->pbCertEncoded, cert->cbCertEncoded);
			if (r != 0) {
				CAMLreturn(Val_int(r));
			}
		}
		CertCloseStore(store, 0);
	}
	#endif

	#ifdef __APPLE__
	CFMutableDictionaryRef search;
	CFArrayRef result;
	SecKeychainRef keychain;
	SecCertificateRef item;
	CFDataRef dat;
	// Load keychain
	if (SecKeychainOpen("/System/Library/Keychains/SystemRootCertificates.keychain", &keychain) == errSecSuccess) {
		// Search for certificates
		search = CFDictionaryCreateMutable(NULL, 0, NULL, NULL);
		CFDictionarySetValue(search, kSecClass, kSecClassCertificate);
		CFDictionarySetValue(search, kSecMatchLimit, kSecMatchLimitAll);
		CFDictionarySetValue(search, kSecReturnRef, kCFBooleanTrue);
		CFDictionarySetValue(search, kSecMatchSearchList, CFArrayCreate(NULL, (const void **)&keychain, 1, NULL));
		if (SecItemCopyMatching(search, (CFTypeRef *)&result) == errSecSuccess) {
			CFIndex n = CFArrayGetCount(result);
			for (CFIndex i = 0; i < n; i++) {
				item = (SecCertificateRef)CFArrayGetValueAtIndex(result, i);

				// Get certificate in DER format
				dat = SecCertificateCopyData(item);
				if (dat) {
					r = mbedtls_x509_crt_parse_der(chain, (unsigned char *)CFDataGetBytePtr(dat), CFDataGetLength(dat));
					CFRelease(dat);
					if (r != 0) {
						CAMLreturn(Val_int(r));
					}
				}
			}
		}
		CFRelease(keychain);
	}
	#endif

	CAMLreturn(Val_int(r));
}

static value build_fields(int num_fields, const char* names[], int values[]) {
	CAMLparam0();
	CAMLlocal2(ret, tuple);
	ret = caml_alloc(num_fields, 0);
	for (int i = 0; i < num_fields; ++i) {
		tuple = caml_alloc_tuple(2);
		Store_field(tuple, 0, caml_copy_string(names[i]));
		Store_field(tuple, 1, Val_int(values[i]));
		Store_field(ret, i, tuple);
	}
	CAMLreturn(ret);
}

CAMLprim value hx_get_ssl_authmode_flags(value unit) {
	CAMLparam1(unit);
	const char* names[] = {"SSL_VERIFY_NONE", "SSL_VERIFY_OPTIONAL", "SSL_VERIFY_REQUIRED"};
	int values[] = {MBEDTLS_SSL_VERIFY_NONE, MBEDTLS_SSL_VERIFY_OPTIONAL, MBEDTLS_SSL_VERIFY_REQUIRED};
	CAMLreturn(build_fields(sizeof(values) / sizeof(values[0]), names, values));
}

CAMLprim value hx_get_ssl_endpoint_flags(value unit) {
	CAMLparam1(unit);
	const char* names[] = {"SSL_IS_CLIENT", "SSL_IS_SERVER"};
	int values[] = {MBEDTLS_SSL_IS_CLIENT, MBEDTLS_SSL_IS_SERVER};
	CAMLreturn(build_fields(sizeof(values) / sizeof(values[0]), names, values));
}

CAMLprim value hx_get_ssl_preset_flags(value unit) {
	CAMLparam1(unit);
	const char* names[] = {"SSL_PRESET_DEFAULT", "SSL_PRESET_SUITEB"};
	int values[] = {MBEDTLS_SSL_PRESET_DEFAULT, MBEDTLS_SSL_PRESET_SUITEB};
	CAMLreturn(build_fields(sizeof(values) / sizeof(values[0]), names, values));
}

CAMLprim value hx_get_ssl_transport_flags(value unit) {
	CAMLparam1(unit);
	const char* names[] = {"SSL_TRANSPORT_STREAM", "SSL_TRANSPORT_DATAGRAM"};
	int values[] = {MBEDTLS_SSL_TRANSPORT_STREAM, MBEDTLS_SSL_TRANSPORT_DATAGRAM};
	CAMLreturn(build_fields(sizeof(values) / sizeof(values[0]), names, values));
}