From fb11ffeb2d98f239b20e618c65b8534b677957e9 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Wed, 24 Mar 2021 14:58:32 -0400 Subject: Initial import --- common/request.f90 | 294 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 294 insertions(+) create mode 100644 common/request.f90 (limited to 'common/request.f90') diff --git a/common/request.f90 b/common/request.f90 new file mode 100644 index 0000000..e9043c0 --- /dev/null +++ b/common/request.f90 @@ -0,0 +1,294 @@ +! Copyright (c) 2020 Jeffrey Armstrong +! +! 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. + +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 + + character(23), dimension(0:6), parameter:: connection_code_str = & + ["No Connection ", & + "Connection Closed ", & + "Server Not Found ", & + "Local Socket Failure ", & + "SSL Configuration Error", & + "SSL Connection Failure ", & + "SSL Connection Open " ] + + + type :: connection + + integer::code + + type(simple_hostent)::host + integer::socket + type(c_ptr)::ssl_ctx + type(c_ptr)::ssl + + end type connection + +contains + + function translate_connection_code(code) + implicit none + + integer, intent(in)::code + character(23)::translate_connection_code + + if(code >= lbound(connection_code_str, 1) .and. & + code <= ubound(connection_code_str, 1)) then + + translate_connection_code = connection_code_str(code) + + else + + translate_connection_code = "Unknown Error" + + end if + + end function translate_connection_code + + 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_client_method() + conn%ssl_ctx = ctx_new(ssl_method) + + conn%ssl = ssl_new(conn%ssl_ctx) + if((.not. c_associated(conn%ssl)) .or. & + (set_tlsext_host_name(conn%ssl, server) == 0) .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 + + subroutine get_server_from_url(url, server, port) + implicit none + + character(*), intent(in)::url + character(*), intent(out)::server + integer, intent(out), optional::port + + integer::start_server, end_server, length + integer::start_port, iostatus + integer::myport + + myport = -1 + + 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 + ! Get rid of trailing slash + end_server = end_server + start_server - 2 + end if + length = end_server - start_server + 1 + + server = url(start_server:end_server) + + end if + + ! Need to check if a port was specified too + start_port = index(server, ":") + if(start_port > 0) then + + read(server(start_port+1:len_trim(server)), *, iostat=iostatus) myport + if(iostatus /= 0) then + myport = -1 + end if + + server = server(1:start_port-1) + + end if + + if(present(port)) then + port = myport + end if + + end subroutine get_server_from_url + + function send_string(ssl, str, trimming) result(success) + use iso_c_binding + use jessl + implicit none + + logical::success + type(c_ptr)::ssl + character(*), intent(in)::str + logical, intent(in), optional::trimming + + integer::start_send + integer::chars_sent_this_time, chars_sending + integer::i, bytes + integer::string_length + + character, dimension(bufsize)::buffer + + if(present(trimming)) then + if(trimming) then + string_length = len_trim(str) + else + string_length = len(str) + end if + else + string_length = len_trim(str) + end if + + success = .true. + start_send = 1 + do while(start_send <= string_length) + + chars_sending = 0 + do i = start_send, string_length + buffer(i-start_send+1) = str(i:i) + chars_sending = chars_sending + 1 + if(chars_sending == bufsize) then + exit + end if + end do + + ! A null character seems necessary at the end of the request + if(i >= string_length) then + chars_sending = chars_sending + 1 + buffer(chars_sending) = c_null_char + end if + + ! Minus 1 because we're sending start_send as well + chars_sent_this_time = ssl_write(ssl, buffer(start_send:(start_send+chars_sending-1))) + + if(chars_sent_this_time < 0) then + success = .false. + exit + end if + + start_send = start_send + chars_sent_this_time + + end do + + end function send_string + + function retrieve_characters(ssl, arr) result(chars_read) + use iso_c_binding + use jessl + implicit none + + integer::chars_read + type(c_ptr)::ssl + character(len=1), dimension(:), intent(inout)::arr + + chars_read = ssl_read(ssl, arr) + + end function retrieve_characters + +end module request -- cgit v1.2.3