aboutsummaryrefslogtreecommitdiff
path: root/jessl.f90
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2020-04-29 17:39:05 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2020-04-29 17:39:05 -0400
commit537ff39898992c3915bcf01e3840becc6750520f (patch)
tree0e0883ac2c10c88c7c79d4149a2db474c4a7daab /jessl.f90
parentdfd21b695107fc01941e3218b60d360ee38fb150 (diff)
downloadLR-87-537ff39898992c3915bcf01e3840becc6750520f.zip
LR-87-537ff39898992c3915bcf01e3840becc6750520f.tar.gz
Added some very low-level network code
Diffstat (limited to 'jessl.f90')
-rw-r--r--jessl.f90163
1 files changed, 163 insertions, 0 deletions
diff --git a/jessl.f90 b/jessl.f90
new file mode 100644
index 0000000..a27803e
--- /dev/null
+++ b/jessl.f90
@@ -0,0 +1,163 @@
+! Just Enough SSL...
+
+module jessl
+implicit none
+
+ interface
+
+ subroutine library_init() bind(c, name="SSL_library_init")
+ 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_v1_3_client_method() bind(c, name="TLSv1_2_client_method")
+ use iso_c_binding
+ type(c_ptr)::tls_v1_3_client_method
+ end function tls_v1_3_client_method
+
+ 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 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 ssl_connect(ssl) bind(c, name="SSL_connect")
+ use iso_c_binding
+ integer(kind=c_int)::connect
+ type(c_ptr), value::ssl
+ end function ssl_connect
+
+ ! 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
+
+ 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
+
+ character(kind=c_char), dimension(:), allocatable::cbuf
+
+ allocate(cbuf(size(buf)))
+
+ ssl_read = read_c(ssl, cbuf, size(buf))
+ 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
+
+ function get_cipher(ssl)
+ use iso_c_binding
+ implicit none
+
+ character(:), allocatable::get_cipher
+ 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)::get_cipher)
+ get_cipher = " "
+
+ 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))::get_cipher)
+
+ i = 1
+ do while(cstring(i) /= c_null_char)
+ get_cipher(i:i) = cstring(i)
+ end do
+
+ end if
+
+ end function get_cipher
+
+end module jessl