Skip to content
Newer
Older
100644 570 lines (456 sloc) 13.5 KB
fccc685 Initial open-source release
MLstate authored
1 /*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 */
18 /*
19 @author Frederic Ye
20 **/
21
22 /* Warning: The following code is highly inspired by Ocaml-ssl binding
23 -> TODO: Check Ocaml-ssl licence */
24
25 #include <caml/alloc.h>
26 #include <caml/callback.h>
27 #include <caml/custom.h>
28 #include <caml/fail.h>
29 #include <caml/memory.h>
30 #include <caml/mlvalues.h>
31 #include <caml/signals.h>
32
33 #include <openssl/ssl.h>
34 #include <openssl/pem.h>
35 #include <openssl/err.h>
36 #include <openssl/crypto.h>
37 #include <openssl/bn.h>
38 #include <openssl/engine.h>
39
40 // SSL
41 /* Some definitions from Ocaml-SSL */
42 #define Cert_val(v) (*((X509**)Data_custom_val(v)))
43 #define RSA_val(v) (*((RSA**)Data_custom_val(v)))
44 #define Ctx_val(v) (*((SSL_CTX**)Data_custom_val(v)))
45 #define SSL_val(v) (*((SSL**)Data_custom_val(v)))
46 #define ONELINE_NAME(X) X509_NAME_oneline(X, 0, 0)
47
48 #include "../libbase/mlstate_platform.h"
49
50 #ifdef MLSTATE_WINDOWS
51 #include <io.h>
52 #include <process.h>
53 #else
54 #include <unistd.h>
55 #endif
56
57 #include <string.h>
58 #include <assert.h>
59
60
61 CAMLprim value ocaml_ssl_ext_init(void) {
62 /* ERR_load_crypto_strings(); */
63 OpenSSL_add_all_digests();
64 OpenSSL_add_all_ciphers();
65 OpenSSL_add_all_algorithms();
66 /* ENGINE_load_builtin_engines(); */
67 return Val_unit;
68 }
69
70 static int s_server_session_id_context = 1; /* anything will do */
71 CAMLprim value ocaml_ssl_ext_ctx_set_session_id_context(value context)
72 {
73 CAMLparam1(context);
74 SSL_CTX *ctx = Ctx_val(context);
75
76 caml_enter_blocking_section();
77 SSL_CTX_set_session_id_context(ctx,(void*)&s_server_session_id_context,
78 sizeof s_server_session_id_context);
79 caml_leave_blocking_section();
80
81 CAMLreturn(Val_unit);
82 }
83
84 CAMLprim value ocaml_ssl_ext_ctx_set_options(value context)
85 {
86 CAMLparam1(context);
87 long ans;
88 SSL_CTX *ctx = Ctx_val(context);
89
90 caml_enter_blocking_section();
91 ans = SSL_CTX_set_options(ctx, SSL_OP_ALL | SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION);
92 caml_leave_blocking_section();
93
94 CAMLreturn(Val_long(ans));
95 }
96
97 CAMLprim value ocaml_ssl_ext_ctx_set_accept_renegotiate(value context)
98 {
99 CAMLparam1(context);
100 long ans;
101 SSL_CTX *ctx = Ctx_val(context);
102
103 caml_enter_blocking_section();
104 ans = SSL_CTX_sess_accept_renegotiate(ctx);
105 caml_leave_blocking_section();
106
107 CAMLreturn(Val_long(ans));
108 }
109
110 static int no_client_verify_callback(int, X509_STORE_CTX *);
111
112 CAMLprim value ocaml_ssl_ext_get_no_client_verify_callback_ptr(value unit)
113 {
114 return (value)no_client_verify_callback;
115 }
116
117 CAMLprim value ocaml_ssl_ext_get_signature(value certificate)
118 {
119 CAMLparam1(certificate);
120 X509 *cert = Cert_val(certificate);
121 unsigned char *signature ; //= cert->signature->data;
122
123 caml_enter_blocking_section();
124 signature = cert->signature->data;
125
126 caml_leave_blocking_section();
127 if (signature == NULL) caml_raise_not_found ();
128
129 CAMLreturn(caml_copy_string(String_val(signature)));
130 }
131
132 CAMLprim value ocaml_ssl_ext_get_hash(value certificate)
133 {
134 CAMLparam1(certificate);
135 X509 *cert = Cert_val(certificate);
136 unsigned char *hash ; //= cert->sha1_hash;
137
138 caml_enter_blocking_section();
139 hash = cert->sha1_hash;
140 caml_leave_blocking_section();
141 if (hash == NULL) caml_raise_not_found ();
142
143 CAMLreturn(caml_copy_string(String_val(hash)));
144 }
145
146 CAMLprim value ocaml_ssl_ext_compute_digest(value certificate, value dname)
147 {
148 CAMLparam2(certificate, dname);
149 X509 *cert = Cert_val(certificate);
150 char *digest_name = String_val(dname);
151 unsigned int n;
152 unsigned char digest[64];
153
154 const EVP_MD *fdig = EVP_get_digestbyname(digest_name);
155
156 caml_enter_blocking_section();
157 // @see evp.h #define EVP_MAX_MD_SIZE 64 /* longest known is SHA512 */
158
159 X509_digest(cert,fdig,digest,&n);
160 caml_leave_blocking_section();
161 if (digest == NULL) caml_raise_not_found ();
162
163 CAMLreturn(caml_copy_string(String_val(digest)));
164 }
165
166 static int no_client_verify_callback(int ok, X509_STORE_CTX *ctx)
167 {
168 char *subject, *issuer;
169 unsigned char *signature;
170 char *xs;
171
172 xs = (char *)X509_STORE_CTX_get_current_cert(ctx);
173
174 subject = issuer = NULL;
175 signature = NULL;
176
177 /* First thing is to have a meaningful name for the current
178 * certificate that is being verified ... and if we cannot
179 * determine that then something is seriously wrong!
180 */
181 subject=(char*)ONELINE_NAME(X509_get_subject_name((X509*)xs));
182 if (subject == NULL)
183 {
184 ERR_print_errors_fp(stderr);
185 ok = 0;
186 goto return_time;
187 }
188 issuer = (char*)ONELINE_NAME(X509_get_issuer_name((X509*)xs));
189 if (issuer == NULL)
190 {
191 ERR_print_errors_fp(stderr);
192 ok = 0;
193 goto return_time;
194 }
195 signature = (((X509*)xs)->signature)->data;
196 if (signature == NULL) {
197 ERR_print_errors_fp(stderr);
198 ok = 0;
199 goto return_time;
200 }
201
202 ok = 1;
203
204 return_time:
205
206 /* Clean up things. */
207 if (subject)
208 free(subject);
209 if (issuer)
210 free(issuer);
211
212 return ok;
213 }
214
215 void print_ssl_error(err) {
216 switch (err) {
217 case SSL_ERROR_NONE: printf("SSL_ERROR_NONE\n"); break;
218 case SSL_ERROR_ZERO_RETURN: printf("SSL_ERROR_ZERO_RETURN\n"); break;
219 case SSL_ERROR_WANT_READ: printf("SSL_ERROR_WANT_READ\n"); break;
220 case SSL_ERROR_WANT_WRITE: printf("SSL_ERROR_WANT_WRITE\n"); break;
221 case SSL_ERROR_WANT_CONNECT: printf("SSL_ERROR_WANT_CONNECT\n"); break;
222 case SSL_ERROR_WANT_ACCEPT: printf("SSL_ERROR_WANT_ACCEPT\n"); break;
223 case SSL_ERROR_WANT_X509_LOOKUP: printf("SSL_ERROR_WANT_X509_LOOKUP\n"); break;
224 case SSL_ERROR_SYSCALL: printf("SSL_ERROR_SYSCALL\n"); break;
225 case SSL_ERROR_SSL: printf("SSL_ERROR_SSL\n"); break;
226 default: printf("...\n"); break;
227 }
228 }
229
230 CAMLprim value ocaml_ssl_ext_renegotiate(value socket)
231 {
232 CAMLparam1(socket);
233 SSL *ssl = SSL_val(socket);
234 int ret;
235 caml_enter_blocking_section();
236 ret = SSL_renegotiate(ssl);
237 caml_leave_blocking_section();
238 if(ret <= 0)
239 caml_raise_constant(*caml_named_value("ssl_ext_exn_renegotiation_error"));
240 CAMLreturn(Val_unit);
241 }
242
243
244 /* Very basic implementation of a certificate chain check:
245 Must be greatly improved!!! */
246 CAMLprim value ocaml_ssl_ext_verify_chain(value certificate, value caf)
247 {
248 CAMLparam2(certificate, caf);
249 char *cafile = String_val(caf);
250 X509 *cert = Cert_val(certificate);
251 int i = 0;
252 X509_STORE *ctx=X509_STORE_new();
253 X509_LOOKUP *lookup=X509_STORE_add_lookup(ctx,X509_LOOKUP_file());
254 X509_STORE_CTX *csc=X509_STORE_CTX_new();
255
256 /* printf("CAfile %s\n", cafile); */
257 /* printf("Certificate: "); */
258 /* X509_NAME_print_ex_fp(stdout, */
259 /* X509_get_subject_name(cert), */
260 /* 0, XN_FLAG_ONELINE); */
261 /* printf("\n"); */
262
263
264 if (ctx == NULL) printf("ctx error\n");
265
266 OpenSSL_add_all_algorithms();
267
268 if (lookup == NULL) printf("lookup error\n");
269 if (!X509_LOOKUP_load_file(lookup,cafile,X509_FILETYPE_PEM)) {
270 printf("error load file\n");
271 }
272
273 if (csc == NULL) printf("csc error\n");
274
275 X509_STORE_set_flags(ctx, 0);
276 if (!X509_STORE_CTX_init(csc,ctx,cert,NULL)) {
277 printf("store init error\n");
278 }
279
280 i = X509_verify_cert(csc);
281
282 X509_STORE_CTX_free(csc);
283 X509_STORE_free(ctx);
284
285 CAMLreturn(Val_int(i));
286 }
287
288 CAMLprim value ocaml_ssl_ext_do_handshake(value socket)
289 {
290 CAMLparam1(socket);
291 int ret;
292 int err;
293 SSL *ssl = SSL_val(socket);
294
295 caml_enter_blocking_section();
296 ret = SSL_do_handshake(ssl);
297 err = SSL_get_error(ssl, ret);
298 caml_leave_blocking_section();
299 if (err != SSL_ERROR_NONE)
300 caml_raise_with_arg(*caml_named_value("ssl_ext_exn_handshake_error"), Val_int(err));
301 CAMLreturn(Val_unit);
302 }
303
304 CAMLprim value ocaml_ssl_ext_set_verify(value socket, value vmode, value vcallback)
305 {
306 CAMLparam3(socket, vmode, vcallback);
307 SSL *ssl = SSL_val(socket);
308 int mode = 0;
309 value mode_tl = vmode;
310 int (*callback) (int, X509_STORE_CTX*) = NULL;
311
312 if (Is_long(vmode))
313 mode = SSL_VERIFY_NONE;
314
315 while (Is_block(mode_tl))
316 {
317 switch(Int_val(Field(mode_tl, 0)))
318 {
319 case 0:
320 mode |= SSL_VERIFY_PEER;
321 break;
322
323 case 1:
324 mode |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT | SSL_VERIFY_PEER;
325 break;
326
327 case 2:
328 mode |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
329 break;
330
331 default:
332 caml_invalid_argument("mode");
333 }
334
335 mode_tl = Field(mode_tl, 1);
336 }
337
338 if (Is_block(vcallback))
339 callback = (int(*) (int, X509_STORE_CTX*))Field(vcallback, 0);
340
341 caml_enter_blocking_section();
342 SSL_set_verify(ssl, mode, callback);
343 caml_leave_blocking_section();
344
345 CAMLreturn(Val_unit);
346 }
347
348 CAMLprim value ocaml_ssl_ext_set_verify_depth(value socket, value vdepth)
349 {
350 SSL *ssl = SSL_val(socket);
351 int depth = Int_val(vdepth);
352
353 if (depth < 0)
354 caml_invalid_argument("depth");
355
356 caml_enter_blocking_section();
357 SSL_set_verify_depth(ssl, depth);
358 caml_leave_blocking_section();
359
360 return Val_unit;
361 }
362
363 CAMLprim value ocaml_ssl_ext_set_accept_state(value socket)
364 {
365 SSL *ssl = SSL_val(socket);
366
367 caml_enter_blocking_section();
368 SSL_set_accept_state(ssl);
369 caml_leave_blocking_section();
370
371 return Val_unit;
372 }
373
374 CAMLprim value ocaml_ssl_ext_set_state(value socket, value state)
375 {
376 SSL *ssl = SSL_val(socket);
377 int st = Int_val(state);
378
379 caml_enter_blocking_section();
380 ssl->state=st;
381 caml_leave_blocking_section();
382
383 return Val_unit;
384 }
385
386 CAMLprim value ocaml_ssl_ext_get_verify_mode(value socket)
387 {
388 CAMLparam1(socket);
389 int ans;
390 SSL *ssl = SSL_val(socket);
391
392 caml_enter_blocking_section();
393 ans = SSL_get_verify_mode(ssl);
394 caml_leave_blocking_section();
395
396 CAMLreturn(Val_int(ans));
397 }
398
399 CAMLprim value ocaml_ssl_ext_get_state(value socket)
400 {
401 CAMLparam1(socket);
402 int ans;
403 SSL *ssl = SSL_val(socket);
404
405 caml_enter_blocking_section();
406 ans = SSL_get_state(ssl);
407 caml_leave_blocking_section();
408
409 CAMLreturn(Val_int(ans));
410 }
411
412 CAMLprim value ocaml_ssl_ext_clear(value socket)
413 {
414 CAMLparam1(socket);
415 int ans;
416 SSL *ssl = SSL_val(socket);
417
418 caml_enter_blocking_section();
419 ans = SSL_clear(ssl);
420 caml_leave_blocking_section();
421
422 CAMLreturn(Val_int(ans));
423 }
424
425 CAMLprim value ocaml_ssl_ext_num_renegotiations(value socket)
426 {
427 CAMLparam1(socket);
428 long ans;
429 SSL *ssl = SSL_val(socket);
430
431 caml_enter_blocking_section();
432 ans = SSL_num_renegotiations(ssl);
433 caml_leave_blocking_section();
434
435 CAMLreturn(Val_long(ans));
436 }
437
438 // RSA
439
440 #define RSA_val(v) (*((RSA**)Data_custom_val(v)))
441
442 /* Convert a BIGNUM into a string */
443 char *bn_to_hex(const BIGNUM *bn)
444 {
445 char *res = "";
446 caml_enter_blocking_section();
447 if (bn != NULL)
448 res = BN_bn2hex(bn);
449 caml_leave_blocking_section();
450 return res;
451 }
452
453 CAMLprim value ocaml_ssl_ext_rsa_read_privkey(value vfilename)
454 {
455 value block;
456 char *filename = String_val(vfilename);
457 RSA *rsa = NULL;
458 FILE *fh = NULL;
459
460 if((fh = fopen(filename, "r")) == NULL)
461 caml_raise_constant(*caml_named_value("ssl_ext_exn_rsa_error"));
462
463 caml_enter_blocking_section();
464 if((PEM_read_RSAPrivateKey(fh, &rsa, PEM_def_callback, NULL)) == NULL)
465 {
466 fclose(fh);
467 caml_leave_blocking_section();
468 caml_raise_constant(*caml_named_value("ssl_ext_exn_rsa_error"));
469 }
470 fclose(fh);
471 caml_leave_blocking_section();
472
473 block = caml_alloc(sizeof(RSA*), 0);
474 RSA_val(block) = rsa;
475 return block;
476 }
477
478 CAMLprim value ocaml_ssl_ext_rsa_read_pubkey(value vfilename)
479 {
480 value block;
481 char *filename = String_val(vfilename);
482 RSA *rsa = NULL;
483 FILE *fh = NULL;
484
485 if((fh = fopen(filename, "r")) == NULL)
486 caml_raise_constant(*caml_named_value("ssl_ext_exn_rsa_error"));
487
488 caml_enter_blocking_section();
489 if((PEM_read_RSA_PUBKEY(fh, &rsa, PEM_def_callback, NULL)) == NULL)
490 {
491 fclose(fh);
492 caml_leave_blocking_section();
493 caml_raise_constant(*caml_named_value("ssl_ext_exn_rsa_error"));
494 }
495 fclose(fh);
496 caml_leave_blocking_section();
497
498 block = caml_alloc(sizeof(RSA*), 0);
499 RSA_val(block) = rsa;
500 return block;
501 }
502
503 CAMLprim value ocaml_ssl_ext_rsa_get_size(value key)
504 {
505 CAMLparam1(key);
506 RSA *rsa = RSA_val(key);
507 int size = 0;
508 caml_enter_blocking_section();
509 size = RSA_size(rsa);
510 caml_leave_blocking_section();
511 CAMLreturn(Val_int(size));
512 }
513
514 CAMLprim value ocaml_ssl_ext_rsa_get_n(value key)
515 {
516 CAMLparam1(key);
517 RSA *rsa = RSA_val(key);
518 CAMLreturn(caml_copy_string(String_val(bn_to_hex(rsa->n))));
519 }
520
521 CAMLprim value ocaml_ssl_ext_rsa_get_e(value key)
522 {
523 CAMLparam1(key);
524 RSA *rsa = RSA_val(key);
525 CAMLreturn(caml_copy_string(String_val(bn_to_hex(rsa->e))));
526 }
527
528 CAMLprim value ocaml_ssl_ext_rsa_get_d(value key)
529 {
530 CAMLparam1(key);
531 RSA *rsa = RSA_val(key);
532 CAMLreturn(caml_copy_string(String_val(bn_to_hex(rsa->d))));
533 }
534
535 CAMLprim value ocaml_ssl_ext_rsa_get_p(value key)
536 {
537 CAMLparam1(key);
538 RSA *rsa = RSA_val(key);
539 CAMLreturn(caml_copy_string(String_val(bn_to_hex(rsa->p))));
540 }
541
542 CAMLprim value ocaml_ssl_ext_rsa_get_q(value key)
543 {
544 CAMLparam1(key);
545 RSA *rsa = RSA_val(key);
546 CAMLreturn(caml_copy_string(String_val(bn_to_hex(rsa->q))));
547 }
548
549 CAMLprim value ocaml_ssl_ext_rsa_get_dp(value key)
550 {
551 CAMLparam1(key);
552 RSA *rsa = RSA_val(key);
553 CAMLreturn(caml_copy_string(String_val(bn_to_hex(rsa->dmp1))));
554 }
555
556 CAMLprim value ocaml_ssl_ext_rsa_get_dq(value key)
557 {
558 CAMLparam1(key);
559 RSA *rsa = RSA_val(key);
560 CAMLreturn(caml_copy_string(String_val(bn_to_hex(rsa->dmq1))));
561 }
562
563 CAMLprim value ocaml_ssl_ext_rsa_get_qinv(value key)
564 {
565 CAMLparam1(key);
566 RSA *rsa = RSA_val(key);
567 CAMLreturn(caml_copy_string(String_val(bn_to_hex(rsa->iqmp))));
568 }
569
Something went wrong with that request. Please try again.