diff options
Diffstat (limited to 'jessl.f90')
| -rw-r--r-- | jessl.f90 | 358 |
1 files changed, 358 insertions, 0 deletions
diff --git a/jessl.f90 b/jessl.f90 new file mode 100644 index 0000000..5c1a174 --- /dev/null +++ b/jessl.f90 @@ -0,0 +1,358 @@ +! Copyright (c) 2020 Jeffrey Armstrong <jeff@rainbow-100.com> +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! The Software shall be used for Good, not Evil. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +! SOFTWARE. + +! Just Enough SSL... + +module jessl +use iso_c_binding +implicit none + + ! Constants needed for SNI + integer(kind=c_long), parameter::TLSEXT_NAMETYPE_host_name = 0 + + 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 + + subroutine add_ssl_algorithms() bind(c, name="SSLeay_add_ssl_algorithms") + end subroutine add_ssl_algorithms + + subroutine load_error_strings() bind(c, name="SSL_load_error_strings") + end subroutine load_error_strings + + function tls_client_method() bind(c, name="TLS_client_method") + use iso_c_binding + 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 + type(c_ptr), value::ctx + end function ssl_new + + function get_fd(ssl) bind(c, name="SSL_get_fd") + use iso_c_binding + integer(kind=c_int)::get_fd + type(c_ptr), value::ssl + end function get_fd + + function set_fd(ssl, fd) bind(c, name="SSL_set_fd") + use iso_c_binding + integer(kind=c_int)::set_fd + integer(kind=c_int), value::fd + 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 + type(c_ptr), value::ssl + end function ssl_shutdown + + function ssl_free(ssl) bind(c, name="SSL_free") + use iso_c_binding + integer(kind=c_int)::ssl_free + type(c_ptr), value::ssl + end function ssl_free + + function ctx_free(ctx) bind(c, name="SSL_CTX_free") + use iso_c_binding + integer(kind=c_int)::ctx_free + type(c_ptr), value::ctx + end function ctx_free + + function ssl_ctrl_c(ctx, cmd, arg, vp) bind(c, name="SSL_ctrl") + use iso_c_binding + type(c_ptr), value::ctx + integer(kind=c_int), value::cmd + integer(kind=c_long), value::arg + type(c_ptr), value::vp + integer(kind=c_long)::ssl_ctrl_c + end function ssl_ctrl_c + + ! Actually a macro... + !function get_cipher_c(ssl) bind(c, name="SSL_get_cipher_name") + !use iso_c_binding + !type(c_ptr)::get_cipher_c + !type(c_ptr), value::ssl + !end function get_cipher_c + + function read_c(ssl, buf, length) bind(c, name="SSL_read") + use iso_c_binding + type(c_ptr), value::ssl + character(kind=c_char), dimension(*), intent(inout)::buf + integer(kind=c_int), value::length + integer(kind=c_int)::read_c + end function read_c + + function write_c(ssl, buf, length) bind(c, name="SSL_write") + use iso_c_binding + type(c_ptr), value::ssl + character(kind=c_char), dimension(*), intent(inout)::buf + integer(kind=c_int), value::length + integer(kind=c_int)::write_c + end function write_c + + function get_error(ssl, retcode) bind(c, name="SSL_get_error") + use iso_c_binding + type(c_ptr), value::ssl + integer(kind=c_int), value::retcode + integer(kind=c_int)::get_error + end function get_error + + function ssl_pending(ssl) bind(c, name="SSL_pending") + use iso_c_binding + type(c_ptr), value::ssl + integer(kind=c_int)::ssl_pending + end function ssl_pending + + end interface + +contains + + function ssl_read(ssl, buf) + use iso_c_binding + implicit none + + type(c_ptr)::ssl + character, dimension(:), intent(inout)::buf + integer::ssl_read + integer::bufsize + + character(kind=c_char), dimension(:), allocatable::cbuf + bufsize = size(buf) + allocate(cbuf(bufsize)) + + ssl_read = read_c(ssl, cbuf, bufsize) + buf = cbuf + + deallocate(cbuf) + + end function ssl_read + + function ssl_write(ssl, buf) + use iso_c_binding + implicit none + + type(c_ptr)::ssl + character, dimension(:), intent(in)::buf + integer::ssl_write + + character(kind=c_char), dimension(:), allocatable::cbuf + + allocate(cbuf(size(buf))) + + cbuf = buf + ssl_write = write_c(ssl, cbuf, size(buf)) + + deallocate(cbuf) + + end function ssl_write + + subroutine get_cipher(ssl, res) + use iso_c_binding + implicit none + + character(:), allocatable, intent(out)::res + type(c_ptr)::ssl + + type(c_ptr)::cptr + + character(kind=c_char), dimension(:), pointer::cstring + + integer::i + + cptr = c_null_ptr + if(.not. c_associated(cptr)) then + + allocate(character(len=1)::res) + res = " " + + else + + call c_f_pointer(cptr, cstring, [1]) + + i = 1 + do while(cstring(i) /= c_null_char) + i = i + 1 + end do + allocate(character(len=(i-1))::res) + + i = 1 + do while(cstring(i) /= c_null_char) + res(i:i) = cstring(i) + end do + + end if + + end subroutine get_cipher + + function set_tlsext_host_name(ctx, hostname) + use iso_c_binding + implicit none + + type(c_ptr)::ctx + character(*), intent(in)::hostname + integer::set_tlsext_host_name + + character(kind=c_char), dimension(:), allocatable, target::chostname + + integer::i + + allocate(chostname(len_trim(hostname)+1)) + + do i = 1, len_trim(hostname) + chostname(i) = hostname(i:i) + end do + chostname(len_trim(hostname)+1) = c_null_char + + set_tlsext_host_name = ssl_ctrl_c(ctx, & + SSL_CTRL_SET_TLSEXT_HOSTNAME, & + TLSEXT_NAMETYPE_host_name, & + c_loc(chostname)) + + 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 + +end module jessl |