From 16e91c6e4542d99ea17e233f1b9a64c2dda79123 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Sun, 31 May 2020 12:45:43 -0400 Subject: Imported jessl from GNC with major fix to library init code. --- jessl.f90 | 128 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 124 insertions(+), 4 deletions(-) (limited to 'jessl.f90') diff --git a/jessl.f90 b/jessl.f90 index 0df3180..223fd14 100644 --- a/jessl.f90 +++ b/jessl.f90 @@ -31,10 +31,16 @@ implicit none integer(kind=c_int), parameter::SSL_CTRL_SET_TLSEXT_HOSTNAME = 55 + integer(kind=c_int), parameter::SSL_FILETYPE_PEM = 1 + interface - subroutine library_init() bind(c, name="OPENSSL_init_ssl") - end subroutine library_init + function init_ssl_c(flags, settings) bind(c, name="OPENSSL_init_ssl") + use iso_c_binding + integer(kind=c_int64_t), value::flags + type(c_ptr), value::settings + integer(kind=c_int)::init_ssl_c + end function init_ssl_c subroutine add_ssl_algorithms() bind(c, name="SSLeay_add_ssl_algorithms") end subroutine add_ssl_algorithms @@ -47,12 +53,44 @@ implicit none type(c_ptr)::tls_client_method end function tls_client_method + function tls_server_method() bind(c, name="TLS_server_method") + use iso_c_binding + type(c_ptr)::tls_server_method + end function tls_server_method + + !subroutine print_error() bind(c, name="print_error") + !use iso_c_binding + !end subroutine print_error + function ctx_new(meth) bind(c, name="SSL_CTX_new") use iso_c_binding type(c_ptr)::ctx_new type(c_ptr), value::meth end function ctx_new + function ctx_set_ecdh_auto(ctx, state) bind(c, name="SSL_CTX_set_ecdh_auto") + use iso_c_binding + type(c_ptr), value::ctx + integer(kind=c_int), value::state + integer(kind=c_long)::ctx_set_ecdh_auto + end function ctx_set_ecdh_auto + + function ctx_use_certificate_file_c(ctx, filename, certtype) bind(c, name="SSL_CTX_use_certificate_file") + use iso_c_binding + type(c_ptr), value::ctx + character(kind=c_char), dimension(*), intent(inout)::filename + integer(kind=c_int), value::certtype + integer(kind=c_int)::ctx_use_certificate_file_c + end function ctx_use_certificate_file_c + + function ctx_use_private_key_file_c(ctx, filename, certtype) bind(c, name="SSL_CTX_use_PrivateKey_file") + use iso_c_binding + type(c_ptr), value::ctx + character(kind=c_char), dimension(*), intent(inout)::filename + integer(kind=c_int), value::certtype + integer(kind=c_int)::ctx_use_private_key_file_c + end function ctx_use_private_key_file_c + function ssl_new(ctx) bind(c, name="SSL_new") use iso_c_binding type(c_ptr)::ssl_new @@ -72,12 +110,32 @@ implicit none type(c_ptr), value::ssl end function set_fd + function set_read_fd(ssl, fd) bind(c, name="SSL_set_rfd") + use iso_c_binding + integer(kind=c_int)::set_read_fd + integer(kind=c_int), value::fd + type(c_ptr), value::ssl + end function set_read_fd + + function set_write_fd(ssl, fd) bind(c, name="SSL_set_wfd") + use iso_c_binding + integer(kind=c_int)::set_write_fd + integer(kind=c_int), value::fd + type(c_ptr), value::ssl + end function set_write_fd + function ssl_connect(ssl) bind(c, name="SSL_connect") use iso_c_binding integer(kind=c_int)::ssl_connect type(c_ptr), value::ssl end function ssl_connect + function ssl_accept(ssl) bind(c, name="SSL_accept") + use iso_c_binding + integer(kind=c_int)::ssl_accept + type(c_ptr), value::ssl + end function ssl_accept + function ssl_shutdown(ssl) bind(c, name="SSL_shutdown") use iso_c_binding integer(kind=c_int)::ssl_shutdown @@ -158,7 +216,7 @@ contains bufsize = size(buf) allocate(cbuf(bufsize)) - ssl_read = read_c(ssl, cbuf, 1) + ssl_read = read_c(ssl, cbuf, bufsize) buf = cbuf deallocate(cbuf) @@ -178,7 +236,6 @@ contains allocate(cbuf(size(buf))) cbuf = buf - cbuf(size(buf)) = c_null_char ssl_write = write_c(ssl, cbuf, size(buf)) deallocate(cbuf) @@ -250,5 +307,68 @@ contains deallocate(chostname) end function set_tlsext_host_name + + function ctx_use_certificate_file(ctx, filename, certtype) + use iso_c_binding + implicit none + + type(c_ptr)::ctx + character(*), intent(in)::filename + integer::certtype + logical::ctx_use_certificate_file + + character(kind=c_char), dimension(:), allocatable, target::cfilename + + integer::i + + allocate(cfilename(len_trim(filename)+1)) + do i = 1, len_trim(filename) + cfilename(i) = filename(i:i) + end do + cfilename(len_trim(filename)+1) = c_null_char + i = ctx_use_certificate_file_c(ctx, cfilename, int(certtype, kind=c_int)) + ctx_use_certificate_file = (i == 1) + + deallocate(cfilename) + + end function ctx_use_certificate_file + + function ctx_use_private_key_file(ctx, filename, certtype) + use iso_c_binding + implicit none + + type(c_ptr)::ctx + character(*), intent(in)::filename + integer::certtype + logical::ctx_use_private_key_file + + character(kind=c_char), dimension(:), allocatable, target::cfilename + + integer::i + + allocate(cfilename(len_trim(filename)+1)) + do i = 1, len_trim(filename) + cfilename(i) = filename(i:i) + end do + cfilename(len_trim(filename)+1) = c_null_char + + i = ctx_use_private_key_file_c(ctx, cfilename, int(certtype, kind=c_int)) + ctx_use_private_key_file = (i == 1) + + deallocate(cfilename) + + end function ctx_use_private_key_file + + subroutine library_init() + use iso_c_binding + implicit none + + integer(kind=c_int64_t)::flags + integer::res + + flags = 0 + res = init_ssl_c(flags, c_null_ptr) + + end subroutine library_init end module jessl -- cgit v1.2.3