Initial import

1 files changed, 294 insertions, 0 deletions

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 <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.
+
+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