From 4108ae479d67067789f98267175e127e6a2a61ad Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Fri, 1 May 2020 19:08:46 -0400 Subject: Initial work on a sensible, packaged connection system. --- gemini-windows.prj | 5 +- jessl.f90 | 18 +++++++ protocol.f90 | 40 ++++++++++++++++ request.f90 | 134 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 196 insertions(+), 1 deletion(-) create mode 100644 protocol.f90 diff --git a/gemini-windows.prj b/gemini-windows.prj index 87bd634..ba68877 100644 --- a/gemini-windows.prj +++ b/gemini-windows.prj @@ -21,7 +21,7 @@ "enabled":"1" },{ "filename":".\\test_ssl.f90", - "enabled":"1" + "enabled":"0" },{ "filename":".\\wsa.f90", "enabled":"1" @@ -37,6 +37,9 @@ },{ "filename":".\\layout.f90", "enabled":"1" + },{ + "filename":".\\protocol.f90", + "enabled":"1" },{ "filename":".\\render.f90", "enabled":"1" diff --git a/jessl.f90 b/jessl.f90 index 34fb2a2..bd05d42 100644 --- a/jessl.f90 +++ b/jessl.f90 @@ -50,6 +50,24 @@ implicit none type(c_ptr), value::ssl end function ssl_connect + 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 + ! Actually a macro... !function get_cipher_c(ssl) bind(c, name="SSL_get_cipher_name") !use iso_c_binding diff --git a/protocol.f90 b/protocol.f90 new file mode 100644 index 0000000..fa36fe7 --- /dev/null +++ b/protocol.f90 @@ -0,0 +1,40 @@ +module gemini_protocol +implicit none + + integer, parameter::STATUS_INPUT = 1 + integer, parameter::STATUS_SUCCESS = 2 + integer, parameter::STATUS_REDIRECT = 3 + integer, parameter::STATUS_TEMPFAIL = 4 + integer, parameter::STATUS_PERMFAIL = 5 + integer, parameter::STATUS_CERTREQ = 6 + integer, parameter::STATUS_LOCALFAIL = -1 + +contains + + function request_url(url, unit_number, server_name) result(returncode) + use request + implicit none + + character(*), intent(in)::url + integer, intent(in)::unit_number + character(*), intent(in), optional::server_name + + integer::returncode + + character(:), allocatable::server + + returncode = -1 + + if(present(server_name)) then + allocate(character(len=len_trim(server_name)) :: server) + server = server_name + else + server = get_server_from_url(url) + end if + + + + + end function request_url + +end module gemini_protocol \ No newline at end of file diff --git a/request.f90 b/request.f90 index d470a06..3cc8cbf 100644 --- a/request.f90 +++ b/request.f90 @@ -1,10 +1,144 @@ module request +use network +use iso_c_binding implicit none integer, parameter::bufsize = 65536 + + integer, parameter::CONNECTION_NONE = 0 + integer, parameter::CONNECTION_CLOSED = 1 + integer, parameter::CONNECTION_SERVER_NOT_FOUND = 2 + integer, parameter::CONNECTION_SOCKET_FAILURE = 3 + integer, parameter::CONNECTION_SSL_SETUP_FAILURE = 4 + integer, parameter::CONNECTION_SSL_CONN_FAILURE = 5 + integer, parameter::CONNECTION_OPEN = 6 + + type :: connection + + integer::code + + type(simple_hostent)::host + integer::socket + type(c_ptr)::ssl_ctx + type(c_ptr)::ssl + + end type connection contains + function open_connection(server, port) result(conn) + use jessl + use network + implicit none + + character(*), intent(in)::server + integer, intent(in), optional::port + type(connection)::conn + + type(sockaddr_in), target::sa + type(c_ptr)::ssl_method + + conn%code = CONNECTION_NONE + + ! Lookup host + conn%host = gethostbyname(server) + if((.not. allocated(conn%host%h_name)) .or. (conn%host%h_addr4 == 0)) then + conn%code = CONNECTION_SERVER_NOT_FOUND + return + end if + + ! Build the socket + sa%sin_family = AF_INET + sa%sin_addr%s_addr = conn%host%h_addr4 + if(present(port)) then + sa%sin_port = htons(port) + else + sa%sin_port = htons(1965) + end if + conn%socket = socket(AF_INET, SOCK_STREAM, 0) + if(.not. connect(conn%socket, sa)) then + conn%code = CONNECTION_SOCKET_FAILURE + return + end if + + ! Set up ssl now + ssl_method = tls_v1_3_client_method() + conn%ssl_ctx = ctx_new(ssl_method) + conn%ssl = ssl_new(conn%ssl_ctx) + if((.not. c_associated(conn%ssl)) .or. (set_fd(conn%ssl, conn%socket) /= 1)) then + conn%code = CONNECTION_SSL_SETUP_FAILURE + return + end if + + ! Connect via ssl + if(ssl_connect(conn%ssl) /= 1) then + conn%code = CONNECTION_SSL_CONN_FAILURE + return + end if + + ! Here, the connection is live + conn%code = CONNECTION_OPEN + + end function open_connection + + subroutine close_connection(conn) + use jessl + use network + implicit none + + type(connection), intent(inout)::conn + integer::res + + if(conn%code >= CONNECTION_OPEN) then + res = ssl_shutdown(conn%ssl) + end if + + if(conn%code >= CONNECTION_SSL_CONN_FAILURE) then + res = ssl_free(conn%ssl) + end if + + if(conn%code >= CONNECTION_SSL_SETUP_FAILURE) then + res = ctx_free(conn%ssl_ctx) + end if + + if(conn%code > CONNECTION_SOCKET_FAILURE) then + call close_socket(conn%socket) + end if + + if(conn%code > CONNECTION_SERVER_NOT_FOUND) then + deallocate(conn%host%h_name) + end if + + conn%code = CONNECTION_CLOSED + + end subroutine close_connection + + function get_server_from_url(url) result(server) + implicit none + + character(*), intent(in)::url + character(:), allocatable::server + + integer::start_server, end_server, length + + start_server = index(url, "://") + if(start_server > 0) then + + start_server = start_server + 3 + end_server = index(url(start_server:len_trim(url)), "/") + if(end_server <= 0) then + end_server = len_trim(url) + else + end_server = end_server + start_server - 1 + end if + length = end_server - start_server + 1 + + allocate(character(len=length) :: server) + server = url(start_server:end_server) + end if + + end function get_server_from_url + function send_string(ssl, str, trimming) result(success) use iso_c_binding use jessl -- cgit v1.2.3