path: root/common/request.f90

! 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
            Print *, "Errno is ", ierrno()
            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, allow_trailing_null) 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, allow_trailing_null
        
        integer::start_send
        integer::chars_sent_this_time, chars_sending
        integer::i
        integer::string_length
        logical::end_with_null
        
        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
        
        end_with_null = .true.
        if(present(allow_trailing_null)) then
            end_with_null = allow_trailing_null
        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 .and. end_with_null) 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, timeout) 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
        integer, intent(in), optional::timeout

        if(present(timeout)) then
            chars_read = ssl_read(ssl, arr, timeout)
        else
            chars_read = ssl_read(ssl, arr, 250)
        end if
        
    end function retrieve_characters
    
end module request