From 537ff39898992c3915bcf01e3840becc6750520f Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeff@approximatrix.com>
Date: Wed, 29 Apr 2020 17:39:05 -0400
Subject: Added some very low-level network code

---
 jessl.f90 | 163 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 163 insertions(+)
 create mode 100644 jessl.f90

(limited to 'jessl.f90')

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
-- 
cgit v1.2.3