mbedtls_stubs.c 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644
  1. #include <string.h>
  2. #include <stdio.h>
  3. #ifdef _WIN32
  4. #include <windows.h>
  5. #include <wincrypt.h>
  6. #endif
  7. #ifdef __APPLE__
  8. #include <Security/Security.h>
  9. #endif
  10. #include <caml/mlvalues.h>
  11. #include <caml/alloc.h>
  12. #include <caml/memory.h>
  13. #include <caml/fail.h>
  14. #include <caml/callback.h>
  15. #include <caml/custom.h>
  16. #include "mbedtls/error.h"
  17. #include "mbedtls/ssl.h"
  18. #include "mbedtls/entropy.h"
  19. #include "mbedtls/ctr_drbg.h"
  20. #include "mbedtls/oid.h"
  21. #define PVoid_val(v) (*((void**) Data_custom_val(v)))
  22. void debug(void* ctx, int debug_level, const char* file_name, int line, const char* message) {
  23. printf("%s:%i: %s", file_name, line, message);
  24. }
  25. #define Val_none Val_int(0)
  26. static value Val_some(value v) {
  27. CAMLparam1(v);
  28. CAMLlocal1(some);
  29. some = caml_alloc(1, 0);
  30. Store_field(some, 0, v);
  31. CAMLreturn(some);
  32. }
  33. CAMLprim value ml_mbedtls_strerror(value code) {
  34. CAMLparam1(code);
  35. CAMLlocal1(r);
  36. char buf[128];
  37. mbedtls_strerror(Int_val(code), buf, sizeof(buf));
  38. r = caml_copy_string(buf);
  39. CAMLreturn(r);
  40. }
  41. // CtrDrbg
  42. #define CtrDrbg_val(v) (*((mbedtls_ctr_drbg_context**) Data_custom_val(v)))
  43. static void ml_mbedtls_ctr_drbg_finalize(value v) {
  44. mbedtls_ctr_drbg_context* ctr_drbg = CtrDrbg_val(v);
  45. if (ctr_drbg != NULL) {
  46. mbedtls_ctr_drbg_free(ctr_drbg);
  47. }
  48. }
  49. static struct custom_operations ctr_drbg_ops = {
  50. .identifier = "ml_ctr_drbg",
  51. .finalize = ml_mbedtls_ctr_drbg_finalize,
  52. .compare = custom_compare_default,
  53. .hash = custom_hash_default,
  54. .serialize = custom_serialize_default,
  55. .deserialize = custom_deserialize_default,
  56. };
  57. CAMLprim value ml_mbedtls_ctr_drbg_init(void) {
  58. CAMLparam0();
  59. CAMLlocal1(obj);
  60. obj = caml_alloc_custom(&ctr_drbg_ops, sizeof(mbedtls_ctr_drbg_context*), 0, 1);
  61. mbedtls_ctr_drbg_context* ctr_drbg = malloc(sizeof(mbedtls_ctr_drbg_context));
  62. mbedtls_ctr_drbg_init(ctr_drbg);
  63. CtrDrbg_val(obj) = ctr_drbg;
  64. CAMLreturn(obj);
  65. }
  66. CAMLprim value ml_mbedtls_ctr_drbg_random(value p_rng, value output, value output_len) {
  67. CAMLparam3(p_rng, output, output_len);
  68. CAMLreturn(Val_int(mbedtls_ctr_drbg_random(CtrDrbg_val(p_rng), Bytes_val(output), Int_val(output_len))));
  69. }
  70. CAMLprim value ml_mbedtls_ctr_drbg_seed(value ctx, value p_entropy, value custom) {
  71. CAMLparam2(ctx, custom);
  72. CAMLreturn(Val_int(mbedtls_ctr_drbg_seed(CtrDrbg_val(ctx), mbedtls_entropy_func, PVoid_val(p_entropy), NULL, 0)));
  73. }
  74. // Entropy
  75. #define Entropy_val(v) (*((mbedtls_entropy_context**) Data_custom_val(v)))
  76. static void ml_mbedtls_entropy_finalize(value v) {
  77. mbedtls_entropy_context* entropy = Entropy_val(v);
  78. if (entropy != NULL) {
  79. mbedtls_entropy_free(entropy);
  80. }
  81. }
  82. static struct custom_operations entropy_ops = {
  83. .identifier = "ml_entropy",
  84. .finalize = ml_mbedtls_entropy_finalize,
  85. .compare = custom_compare_default,
  86. .hash = custom_hash_default,
  87. .serialize = custom_serialize_default,
  88. .deserialize = custom_deserialize_default,
  89. };
  90. CAMLprim value ml_mbedtls_entropy_init(void) {
  91. CAMLparam0();
  92. CAMLlocal1(obj);
  93. obj = caml_alloc_custom(&entropy_ops, sizeof(mbedtls_entropy_context*), 0, 1);
  94. mbedtls_entropy_context* entropy = malloc(sizeof(mbedtls_entropy_context));
  95. mbedtls_entropy_init(entropy);
  96. Entropy_val(obj) = entropy;
  97. CAMLreturn(obj);
  98. }
  99. CAMLprim value ml_mbedtls_entropy_func(value data, value output, value len) {
  100. CAMLparam3(data, output, len);
  101. CAMLreturn(Val_int(mbedtls_entropy_func(PVoid_val(data), Bytes_val(output), Int_val(len))));
  102. }
  103. // Certificate
  104. #define X509Crt_val(v) (*((mbedtls_x509_crt**) Data_custom_val(v)))
  105. static void ml_mbedtls_x509_crt_finalize(value v) {
  106. mbedtls_x509_crt* x509_crt = X509Crt_val(v);
  107. if (x509_crt != NULL) {
  108. mbedtls_x509_crt_free(x509_crt);
  109. }
  110. }
  111. static struct custom_operations x509_crt_ops = {
  112. .identifier = "ml_x509_crt",
  113. .finalize = ml_mbedtls_x509_crt_finalize,
  114. .compare = custom_compare_default,
  115. .hash = custom_hash_default,
  116. .serialize = custom_serialize_default,
  117. .deserialize = custom_deserialize_default,
  118. };
  119. CAMLprim value ml_mbedtls_x509_crt_init(void) {
  120. CAMLparam0();
  121. CAMLlocal1(obj);
  122. obj = caml_alloc_custom(&x509_crt_ops, sizeof(mbedtls_x509_crt*), 0, 1);
  123. mbedtls_x509_crt* x509_crt = malloc(sizeof(mbedtls_x509_crt));
  124. mbedtls_x509_crt_init(x509_crt);
  125. X509Crt_val(obj) = x509_crt;
  126. CAMLreturn(obj);
  127. }
  128. CAMLprim value ml_mbedtls_x509_next(value chain) {
  129. CAMLparam1(chain);
  130. CAMLlocal2(r, obj);
  131. mbedtls_x509_crt* cert = X509Crt_val(chain);
  132. if (cert->next == NULL) {
  133. CAMLreturn(Val_none);
  134. }
  135. obj = caml_alloc_custom(&x509_crt_ops, sizeof(mbedtls_x509_crt*), 0, 1);
  136. X509Crt_val(obj) = cert->next;
  137. CAMLreturn(Val_some(obj));
  138. }
  139. CAMLprim value ml_mbedtls_x509_crt_parse(value chain, value bytes) {
  140. CAMLparam2(chain, bytes);
  141. const unsigned char* buf = Bytes_val(bytes);
  142. int len = caml_string_length(bytes);
  143. CAMLreturn(Val_int(mbedtls_x509_crt_parse(X509Crt_val(chain), buf, len + 1)));
  144. }
  145. CAMLprim value ml_mbedtls_x509_crt_parse_file(value chain, value path) {
  146. CAMLparam2(chain, path);
  147. CAMLreturn(Val_int(mbedtls_x509_crt_parse_file(X509Crt_val(chain), String_val(path))));
  148. }
  149. CAMLprim value ml_mbedtls_x509_crt_parse_path(value chain, value path) {
  150. CAMLparam2(chain, path);
  151. CAMLreturn(Val_int(mbedtls_x509_crt_parse_path(X509Crt_val(chain), String_val(path))));
  152. }
  153. // Certificate Haxe API
  154. value caml_string_of_asn1_buf(mbedtls_asn1_buf* dat) {
  155. CAMLparam0();
  156. CAMLlocal1(s);
  157. s = caml_alloc_initialized_string(dat->len, (const char *)dat->p);
  158. CAMLreturn(s);
  159. }
  160. CAMLprim value hx_cert_get_alt_names(value chain) {
  161. CAMLparam1(chain);
  162. CAMLlocal1(obj);
  163. mbedtls_x509_crt* cert = X509Crt_val(chain);
  164. #if MBEDTLS_VERSION_MAJOR >= 3
  165. if (!mbedtls_x509_crt_has_ext_type(cert, MBEDTLS_X509_EXT_SUBJECT_ALT_NAME)) {
  166. #else
  167. if ((cert->ext_types & MBEDTLS_X509_EXT_SUBJECT_ALT_NAME) == 0) {
  168. #endif
  169. obj = Atom(0);
  170. } else {
  171. mbedtls_asn1_sequence* cur = &cert->subject_alt_names;
  172. int i = 0;
  173. while (cur != NULL) {
  174. ++i;
  175. cur = cur->next;
  176. }
  177. obj = caml_alloc(i, 0);
  178. cur = &cert->subject_alt_names;
  179. i = 0;
  180. while (cur != NULL) {
  181. Store_field(obj, i, caml_string_of_asn1_buf(&cur->buf));
  182. ++i;
  183. cur = cur->next;
  184. }
  185. }
  186. CAMLreturn(obj);
  187. }
  188. CAMLprim value hx_cert_get_subject(value chain, value objname) {
  189. CAMLparam2(chain, objname);
  190. mbedtls_x509_name *obj;
  191. mbedtls_x509_crt* cert = X509Crt_val(chain);
  192. const char *oname, *rname;
  193. obj = &cert->subject;
  194. rname = String_val(objname);
  195. while (obj != NULL) {
  196. int r = mbedtls_oid_get_attr_short_name(&obj->oid, &oname);
  197. if (r == 0 && strcmp(oname, rname) == 0) {
  198. CAMLreturn(Val_some(caml_string_of_asn1_buf(&obj->val)));
  199. }
  200. obj = obj->next;
  201. }
  202. CAMLreturn(Val_none);
  203. }
  204. CAMLprim value hx_cert_get_issuer(value chain, value objname) {
  205. CAMLparam2(chain, objname);
  206. mbedtls_x509_name *obj;
  207. mbedtls_x509_crt* cert = X509Crt_val(chain);
  208. int r;
  209. const char *oname, *rname;
  210. obj = &cert->issuer;
  211. rname = String_val(objname);
  212. while (obj != NULL) {
  213. r = mbedtls_oid_get_attr_short_name(&obj->oid, &oname);
  214. if (r == 0 && strcmp(oname, rname) == 0) {
  215. CAMLreturn(Val_some(caml_string_of_asn1_buf(&obj->val)));
  216. }
  217. obj = obj->next;
  218. }
  219. CAMLreturn(Val_none);
  220. }
  221. time_t time_to_time_t(mbedtls_x509_time* t) {
  222. struct tm info;
  223. info.tm_year = t->year - 1900;
  224. info.tm_mon = t->mon - 1;
  225. info.tm_mday = t->day;
  226. info.tm_hour = t->hour;
  227. info.tm_min = t->min;
  228. info.tm_sec = t->sec;
  229. return mktime(&info);
  230. }
  231. CAMLprim value hx_cert_get_notafter(value chain) {
  232. CAMLparam1(chain);
  233. mbedtls_x509_crt* cert = X509Crt_val(chain);
  234. mbedtls_x509_time *t = &cert->valid_to;
  235. time_t time = time_to_time_t(t);
  236. CAMLreturn(caml_copy_double((double)time));
  237. }
  238. CAMLprim value hx_cert_get_notbefore(value chain) {
  239. CAMLparam1(chain);
  240. mbedtls_x509_crt* cert = X509Crt_val(chain);
  241. mbedtls_x509_time *t = &cert->valid_from;
  242. time_t time = time_to_time_t(t);
  243. CAMLreturn(caml_copy_double((double)time));
  244. }
  245. // Config
  246. #define Config_val(v) (*((mbedtls_ssl_config**) Data_custom_val(v)))
  247. static void ml_mbedtls_ssl_config_finalize(value v) {
  248. mbedtls_ssl_config* ssl_config = Config_val(v);
  249. if (ssl_config != NULL) {
  250. mbedtls_ssl_config_free(ssl_config);
  251. }
  252. }
  253. static struct custom_operations ssl_config_ops = {
  254. .identifier = "ml_ssl_config",
  255. .finalize = ml_mbedtls_ssl_config_finalize,
  256. .compare = custom_compare_default,
  257. .hash = custom_hash_default,
  258. .serialize = custom_serialize_default,
  259. .deserialize = custom_deserialize_default,
  260. };
  261. #ifdef _WIN32
  262. static int verify_callback(void* param, mbedtls_x509_crt *crt, int depth, uint32_t *flags) {
  263. if (*flags == 0 || *flags & MBEDTLS_X509_BADCERT_CN_MISMATCH) {
  264. return 0;
  265. }
  266. HCERTSTORE store = CertOpenStore(CERT_STORE_PROV_MEMORY, 0, 0, CERT_STORE_DEFER_CLOSE_UNTIL_LAST_FREE_FLAG, NULL);
  267. if(store == NULL) {
  268. return MBEDTLS_ERR_X509_FATAL_ERROR;
  269. }
  270. PCCERT_CONTEXT primary_context = {0};
  271. if(!CertAddEncodedCertificateToStore(store, X509_ASN_ENCODING, crt->raw.p, crt->raw.len, CERT_STORE_ADD_REPLACE_EXISTING, &primary_context)) {
  272. CertCloseStore(store, 0);
  273. return MBEDTLS_ERR_X509_FATAL_ERROR;
  274. }
  275. PCCERT_CHAIN_CONTEXT chain_context = {0};
  276. CERT_CHAIN_PARA parameters = {0};
  277. if(!CertGetCertificateChain(NULL, primary_context, NULL, store, &parameters, 0, NULL, &chain_context)) {
  278. CertFreeCertificateContext(primary_context);
  279. CertCloseStore(store, 0);
  280. return MBEDTLS_ERR_X509_FATAL_ERROR;
  281. }
  282. CERT_CHAIN_POLICY_PARA policy_parameters = {0};
  283. CERT_CHAIN_POLICY_STATUS policy_status = {0};
  284. if(!CertVerifyCertificateChainPolicy(CERT_CHAIN_POLICY_SSL, chain_context, &policy_parameters, &policy_status)) {
  285. CertFreeCertificateChain(chain_context);
  286. CertFreeCertificateContext(primary_context);
  287. CertCloseStore(store, 0);
  288. return MBEDTLS_ERR_X509_FATAL_ERROR;
  289. }
  290. if(policy_status.dwError == 0) {
  291. *flags = 0;
  292. } else {
  293. // if we ever want to read the verification result,
  294. // we need to properly map dwError to flags
  295. *flags |= MBEDTLS_X509_BADCERT_OTHER;
  296. }
  297. CertFreeCertificateChain(chain_context);
  298. CertFreeCertificateContext(primary_context);
  299. CertCloseStore(store, 0);
  300. return 0;
  301. }
  302. #endif
  303. CAMLprim value ml_mbedtls_ssl_config_init(void) {
  304. CAMLparam0();
  305. CAMLlocal1(obj);
  306. obj = caml_alloc_custom(&ssl_config_ops, sizeof(mbedtls_ssl_config*), 0, 1);
  307. mbedtls_ssl_config* ssl_config = malloc(sizeof(mbedtls_ssl_config));
  308. mbedtls_ssl_config_init(ssl_config);
  309. #ifdef _WIN32
  310. mbedtls_ssl_conf_verify(ssl_config, verify_callback, NULL);
  311. #endif
  312. Config_val(obj) = ssl_config;
  313. CAMLreturn(obj);
  314. }
  315. CAMLprim value ml_mbedtls_ssl_conf_authmode(value conf, value authmode) {
  316. CAMLparam2(conf, authmode);
  317. mbedtls_ssl_conf_authmode(Config_val(conf), Int_val(authmode));
  318. CAMLreturn(Val_unit);
  319. }
  320. CAMLprim value ml_mbedtls_ssl_conf_ca_chain(value conf, value ca_chain) {
  321. CAMLparam2(conf, ca_chain);
  322. mbedtls_ssl_conf_ca_chain(Config_val(conf), X509Crt_val(ca_chain), NULL);
  323. CAMLreturn(Val_unit);
  324. }
  325. CAMLprim value ml_mbedtls_ssl_config_defaults(value conf, value endpoint, value transport, value preset) {
  326. CAMLparam4(conf, endpoint, transport, preset);
  327. CAMLreturn(Val_int(mbedtls_ssl_config_defaults(Config_val(conf), Int_val(endpoint), Int_val(transport), Int_val(preset))));
  328. }
  329. CAMLprim value ml_mbedtls_ssl_conf_rng(value conf, value p_rng) {
  330. CAMLparam2(conf, p_rng);
  331. mbedtls_ssl_conf_rng(Config_val(conf), mbedtls_ctr_drbg_random, PVoid_val(p_rng));
  332. CAMLreturn(Val_unit);
  333. }
  334. // Pk
  335. #define PkContext_val(v) (*((mbedtls_pk_context**) Data_custom_val(v)))
  336. static void ml_mbedtls_pk_context_finalize(value v) {
  337. mbedtls_pk_context* pk_context = PkContext_val(v);
  338. if (pk_context != NULL) {
  339. mbedtls_pk_free(pk_context);
  340. }
  341. }
  342. static struct custom_operations pk_context_ops = {
  343. .identifier = "ml_pk_context",
  344. .finalize = ml_mbedtls_pk_context_finalize,
  345. .compare = custom_compare_default,
  346. .hash = custom_hash_default,
  347. .serialize = custom_serialize_default,
  348. .deserialize = custom_deserialize_default,
  349. };
  350. CAMLprim value ml_mbedtls_pk_init(void) {
  351. CAMLparam0();
  352. CAMLlocal1(obj);
  353. obj = caml_alloc_custom(&pk_context_ops, sizeof(mbedtls_pk_context*), 0, 1);
  354. mbedtls_pk_context* pk_context = malloc(sizeof(mbedtls_pk_context));
  355. mbedtls_pk_init(pk_context);
  356. PkContext_val(obj) = pk_context;
  357. CAMLreturn(obj);
  358. }
  359. CAMLprim value ml_mbedtls_pk_parse_key(value ctx, value key, value password, value rng) {
  360. CAMLparam4(ctx, key, password, rng);
  361. const unsigned char* pwd = NULL;
  362. size_t pwdlen = 0;
  363. if (password != Val_none) {
  364. pwd = Bytes_val(Field(password, 0));
  365. pwdlen = caml_string_length(Field(password, 0));
  366. }
  367. #if MBEDTLS_VERSION_MAJOR >= 3
  368. mbedtls_ctr_drbg_context *ctr_drbg = CtrDrbg_val(rng);
  369. CAMLreturn(mbedtls_pk_parse_key(PkContext_val(ctx), Bytes_val(key), caml_string_length(key) + 1, pwd, pwdlen, mbedtls_ctr_drbg_random, NULL));
  370. #else
  371. CAMLreturn(mbedtls_pk_parse_key(PkContext_val(ctx), Bytes_val(key), caml_string_length(key) + 1, pwd, pwdlen));
  372. #endif
  373. }
  374. CAMLprim value ml_mbedtls_pk_parse_keyfile(value ctx, value path, value password, value rng) {
  375. CAMLparam4(ctx, path, password, rng);
  376. const char* pwd = NULL;
  377. if (password != Val_none) {
  378. pwd = String_val(Field(password, 0));
  379. }
  380. #if MBEDTLS_VERSION_MAJOR >= 3
  381. mbedtls_ctr_drbg_context *ctr_drbg = CtrDrbg_val(rng);
  382. CAMLreturn(mbedtls_pk_parse_keyfile(PkContext_val(ctx), String_val(path), pwd, mbedtls_ctr_drbg_random, ctr_drbg));
  383. #else
  384. CAMLreturn(mbedtls_pk_parse_keyfile(PkContext_val(ctx), String_val(path), pwd));
  385. #endif
  386. }
  387. CAMLprim value ml_mbedtls_pk_parse_public_key(value ctx, value key) {
  388. CAMLparam2(ctx, key);
  389. CAMLreturn(mbedtls_pk_parse_public_key(PkContext_val(ctx), Bytes_val(key), caml_string_length(key) + 1));
  390. }
  391. CAMLprim value ml_mbedtls_pk_parse_public_keyfile(value ctx, value path) {
  392. CAMLparam2(ctx, path);
  393. CAMLreturn(mbedtls_pk_parse_public_keyfile(PkContext_val(ctx), String_val(path)));
  394. }
  395. // Ssl
  396. #define SslContext_val(v) (*((mbedtls_ssl_context**) Data_custom_val(v)))
  397. static void ml_mbedtls_ssl_context_finalize(value v) {
  398. mbedtls_ssl_context* ssl_context = SslContext_val(v);
  399. if (ssl_context != NULL) {
  400. mbedtls_ssl_free(ssl_context);
  401. }
  402. }
  403. static struct custom_operations ssl_context_ops = {
  404. .identifier = "ml_ssl_context",
  405. .finalize = ml_mbedtls_ssl_context_finalize,
  406. .compare = custom_compare_default,
  407. .hash = custom_hash_default,
  408. .serialize = custom_serialize_default,
  409. .deserialize = custom_deserialize_default,
  410. };
  411. CAMLprim value ml_mbedtls_ssl_init(void) {
  412. CAMLparam0();
  413. CAMLlocal1(obj);
  414. obj = caml_alloc_custom(&ssl_context_ops, sizeof(mbedtls_ssl_context*), 0, 1);
  415. mbedtls_ssl_context* ssl_context = malloc(sizeof(mbedtls_ssl_context));
  416. mbedtls_ssl_init(ssl_context);
  417. SslContext_val(obj) = ssl_context;
  418. CAMLreturn(obj);
  419. }
  420. CAMLprim value ml_mbedtls_ssl_get_peer_cert(value ssl) {
  421. CAMLparam1(ssl);
  422. CAMLlocal1(obj);
  423. mbedtls_ssl_context* ssl_context = SslContext_val(ssl);
  424. mbedtls_x509_crt* crt = (mbedtls_x509_crt*)mbedtls_ssl_get_peer_cert(ssl_context);
  425. if (crt == NULL) {
  426. CAMLreturn(Val_none);
  427. }
  428. obj = caml_alloc_custom(&x509_crt_ops, sizeof(mbedtls_x509_crt*), 0, 1);
  429. X509Crt_val(obj) = crt;
  430. CAMLreturn(Val_some(obj));
  431. }
  432. CAMLprim value ml_mbedtls_ssl_handshake(value ssl) {
  433. CAMLparam1(ssl);
  434. CAMLreturn(Val_int(mbedtls_ssl_handshake(SslContext_val(ssl))));
  435. }
  436. CAMLprim value ml_mbedtls_ssl_read(value ssl, value buf, value pos, value len) {
  437. CAMLparam4(ssl, buf, pos, len);
  438. CAMLreturn(Val_int(mbedtls_ssl_read(SslContext_val(ssl), Bytes_val(buf) + Int_val(pos), Int_val(len))));
  439. }
  440. static int bio_write_cb(void* ctx, const unsigned char* buf, size_t len) {
  441. CAMLparam0();
  442. CAMLlocal3(r, s, vctx);
  443. vctx = *(value*)ctx;
  444. s = caml_alloc_initialized_string(len, (const char*)buf);
  445. r = caml_callback2(Field(vctx, 1), Field(vctx, 0), s);
  446. CAMLreturn(Int_val(r));
  447. }
  448. static int bio_read_cb(void* ctx, unsigned char* buf, size_t len) {
  449. CAMLparam0();
  450. CAMLlocal3(r, s, vctx);
  451. vctx = *(value*)ctx;
  452. s = caml_alloc_string(len);
  453. r = caml_callback2(Field(vctx, 2), Field(vctx, 0), s);
  454. memcpy(buf, String_val(s), len);
  455. CAMLreturn(Int_val(r));
  456. }
  457. CAMLprim value ml_mbedtls_ssl_set_bio(value ssl, value p_bio, value f_send, value f_recv) {
  458. CAMLparam4(ssl, p_bio, f_send, f_recv);
  459. CAMLlocal1(ctx);
  460. ctx = caml_alloc(3, 0);
  461. Store_field(ctx, 0, p_bio);
  462. Store_field(ctx, 1, f_send);
  463. Store_field(ctx, 2, f_recv);
  464. // TODO: this allocation is leaked
  465. value *location = malloc(sizeof(value));
  466. *location = ctx;
  467. caml_register_generational_global_root(location);
  468. mbedtls_ssl_set_bio(SslContext_val(ssl), (void*)location, bio_write_cb, bio_read_cb, NULL);
  469. CAMLreturn(Val_unit);
  470. }
  471. CAMLprim value ml_mbedtls_ssl_set_hostname(value ssl, value hostname) {
  472. CAMLparam2(ssl, hostname);
  473. CAMLreturn(Val_int(mbedtls_ssl_set_hostname(SslContext_val(ssl), String_val(hostname))));
  474. }
  475. CAMLprim value ml_mbedtls_ssl_setup(value ssl, value conf) {
  476. CAMLparam2(ssl, conf);
  477. CAMLreturn(Val_int(mbedtls_ssl_setup(SslContext_val(ssl), Config_val(conf))));
  478. }
  479. CAMLprim value ml_mbedtls_ssl_write(value ssl, value buf, value pos, value len) {
  480. CAMLparam4(ssl, buf, pos, len);
  481. CAMLreturn(Val_int(mbedtls_ssl_write(SslContext_val(ssl), Bytes_val(buf) + Int_val(pos), Int_val(len))));
  482. }
  483. // glue
  484. CAMLprim value hx_cert_load_defaults(value certificate) {
  485. CAMLparam1(certificate);
  486. int r = 1;
  487. mbedtls_x509_crt *chain = X509Crt_val(certificate);
  488. #ifdef _WIN32
  489. HCERTSTORE store;
  490. PCCERT_CONTEXT cert;
  491. if (store = CertOpenSystemStore(0, "Root")) {
  492. cert = NULL;
  493. while (cert = CertEnumCertificatesInStore(store, cert)) {
  494. r = mbedtls_x509_crt_parse_der(chain, (unsigned char *)cert->pbCertEncoded, cert->cbCertEncoded);
  495. if (r != 0) {
  496. CAMLreturn(Val_int(r));
  497. }
  498. }
  499. CertCloseStore(store, 0);
  500. }
  501. #endif
  502. #ifdef __APPLE__
  503. CFArrayRef certs;
  504. if (SecTrustCopyAnchorCertificates(&certs) == errSecSuccess) {
  505. CFIndex count = CFArrayGetCount(certs);
  506. for(CFIndex i = 0; i < count; i++) {
  507. SecCertificateRef item = (SecCertificateRef)CFArrayGetValueAtIndex(certs, i);
  508. // Get certificate in DER format
  509. CFDataRef data = SecCertificateCopyData(item);
  510. if(data) {
  511. r = mbedtls_x509_crt_parse_der(chain, (unsigned char *)CFDataGetBytePtr(data), CFDataGetLength(data));
  512. CFRelease(data);
  513. if (r != 0) {
  514. CAMLreturn(Val_int(r));
  515. }
  516. }
  517. }
  518. CFRelease(certs);
  519. }
  520. #endif
  521. CAMLreturn(Val_int(r));
  522. }
  523. static value build_fields(int num_fields, const char* names[], int values[]) {
  524. CAMLparam0();
  525. CAMLlocal2(ret, tuple);
  526. ret = caml_alloc(num_fields, 0);
  527. for (int i = 0; i < num_fields; ++i) {
  528. tuple = caml_alloc_tuple(2);
  529. Store_field(tuple, 0, caml_copy_string(names[i]));
  530. Store_field(tuple, 1, Val_int(values[i]));
  531. Store_field(ret, i, tuple);
  532. }
  533. CAMLreturn(ret);
  534. }
  535. CAMLprim value hx_get_ssl_authmode_flags(value unit) {
  536. CAMLparam1(unit);
  537. const char* names[] = {"SSL_VERIFY_NONE", "SSL_VERIFY_OPTIONAL", "SSL_VERIFY_REQUIRED"};
  538. int values[] = {MBEDTLS_SSL_VERIFY_NONE, MBEDTLS_SSL_VERIFY_OPTIONAL, MBEDTLS_SSL_VERIFY_REQUIRED};
  539. CAMLreturn(build_fields(sizeof(values) / sizeof(values[0]), names, values));
  540. }
  541. CAMLprim value hx_get_ssl_endpoint_flags(value unit) {
  542. CAMLparam1(unit);
  543. const char* names[] = {"SSL_IS_CLIENT", "SSL_IS_SERVER"};
  544. int values[] = {MBEDTLS_SSL_IS_CLIENT, MBEDTLS_SSL_IS_SERVER};
  545. CAMLreturn(build_fields(sizeof(values) / sizeof(values[0]), names, values));
  546. }
  547. CAMLprim value hx_get_ssl_preset_flags(value unit) {
  548. CAMLparam1(unit);
  549. const char* names[] = {"SSL_PRESET_DEFAULT", "SSL_PRESET_SUITEB"};
  550. int values[] = {MBEDTLS_SSL_PRESET_DEFAULT, MBEDTLS_SSL_PRESET_SUITEB};
  551. CAMLreturn(build_fields(sizeof(values) / sizeof(values[0]), names, values));
  552. }
  553. CAMLprim value hx_get_ssl_transport_flags(value unit) {
  554. CAMLparam1(unit);
  555. const char* names[] = {"SSL_TRANSPORT_STREAM", "SSL_TRANSPORT_DATAGRAM"};
  556. int values[] = {MBEDTLS_SSL_TRANSPORT_STREAM, MBEDTLS_SSL_TRANSPORT_DATAGRAM};
  557. CAMLreturn(build_fields(sizeof(values) / sizeof(values[0]), names, values));
  558. }