path: root/captain/gemini.f90

! Copyright (c) 2021 Approximatrix, LLC <support@approximatrix.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 gemini
implicit none

    private
    
    public :: handle_request
    
contains

    subroutine read_request(ssl, req)
    use jessl, only: ssl_read
    use iso_c_binding
    use logging
    implicit none
    
        type(c_ptr)::ssl
        character(*), intent(out)::req
        
        character, dimension(64)::buf
        integer::bufread
        
        integer::i, j
        
        req = " "
        i = 1
        call sleep(1)
        bufread = ssl_read(ssl, buf)
        
        do while(bufread > 0)
            
            do j = 1, bufread
                if(buf(j) == c_new_line) then
                    exit
                end if
                
                if(buf(j) /= c_carriage_return) then
                    req(i:i) = buf(j)
                    i = i + 1
                end if
                
            end do
            
            if(j > bufread) then
                j = bufread
            end if
            
            
            if(buf(j) == c_new_line) then
                exit
            end if
            
            bufread = ssl_read(ssl, buf)
        end do
    
        call write_log("Request Read: "//trim(req), LOG_DEBUG)
    
    end subroutine read_request

    function read_into_buffer(unit_number, buffer)
    implicit none
    
        integer, intent(in)::unit_number
        character, dimension(*), intent(out)::buffer
        integer::read_into_buffer
        
        integer::i, ierr
        
        ierr = 0
        i = 0
        do while(ierr == 0 .and. i < 64)
            i = i + 1
            read(unit_number, iostat=ierr) buffer(i)
        end do
            
        if(ierr /= 0) then
            i = i - 1
        end if
        
        read_into_buffer = i
    
    end function read_into_buffer

    subroutine write_status(ssl, code, meta)
    use iso_c_binding, only: c_ptr, c_carriage_return, c_new_line
    use jessl, only: ssl_write
    use logging
    implicit none
    
        type(c_ptr)::ssl
        integer, intent(in)::code
        character(*), intent(in)::meta
        
        character(8)::int_text
        character(1024)::line
        
        write(int_text, '(I8)') code
        line  = trim(adjustl(int_text))//" "//trim(meta)
        call write_log("Status line: '"//trim(line)//"'", LOG_DEBUG)
        
        call write_string(ssl, trim(line)//c_carriage_return//c_new_line)
        
    end subroutine write_status

    subroutine write_file(ssl, unit_number, mimetype)
    use iso_c_binding, only: c_ptr
    use jessl, only: ssl_write
    use logging
    use gemini_codes
    implicit none
    
        type(c_ptr)::ssl
        integer, intent(in)::unit_number
        character(*), intent(in)::mimetype
        character, dimension(64)::buf
        integer::buflen, written
        
        call write_status(ssl, GEMINI_CODE_SUCCESS, mimetype)

        buflen = read_into_buffer(unit_number, buf)
        do while(buflen > 0)
            written = ssl_write(ssl, buf(1:buflen))
            buflen = read_into_buffer(unit_number, buf)
        end do
            
    end subroutine write_file
    
    subroutine write_redirect(ssl, url)
    use iso_c_binding, only: c_ptr
    use gemini_codes
    implicit none
        
        type(c_ptr)::ssl
        character(*), intent(in)::url
        
        call write_status(ssl, GEMINI_CODE_REDIRECT, url)
    
    end subroutine write_redirect
    
    subroutine write_input_request(ssl, msg, code)
    use iso_c_binding, only: c_ptr
    use gemini_codes
    implicit none
        
        type(c_ptr)::ssl
        character(*), intent(in)::msg
        integer, intent(in), optional::code
        
        if(present(code)) then
            call write_status(ssl, code, msg)
        else
            call write_status(ssl, GEMINI_CODE_INPUT, msg)
        end if
    
    end subroutine write_input_request
    
    subroutine write_failure(ssl)
    use iso_c_binding, only: c_ptr
    use gemini_codes
    implicit none
        
        type(c_ptr)::ssl
        
        call write_status(ssl, GEMINI_CODE_PERMFAIL, "Not Found")
    
    end subroutine write_failure
    
    subroutine write_string(ssl, string)
    use jessl, only: ssl_write
    use iso_c_binding, only: c_ptr
    implicit none
    
        type(c_ptr)::ssl
        character(*)::string
        character, dimension(:), allocatable::buf
        integer::i
        
        allocate(buf(len(string)))
        
        do i = 1, len(string)
            buf(i) = string(i:i)
        end do
        
        i = ssl_write(ssl, buf)
        
        deallocate(buf)
    
    end subroutine write_string

    subroutine handle_request()
    use jessl
    use iso_c_binding
    use config
    use iso_fortran_env
    use external_handling, only: external_request_gemini, external_request_titan
    use api_handling
    use logging
    use m_uuid, only: UUID_LENGTH
    use server_response
    use gemini_codes
    implicit none
    
        ! For our TLS connection
        type(c_ptr)::ctx
        type(c_ptr)::method
        type(c_ptr)::ssl
        integer(kind=c_long)::res
        
        type(request)::req
        type(titan_request)::treq
        type(response)::resp
        
        ! Requested file
        character(1024)::text_request
        
        character(UUID_LENGTH+8)::first
                
        integer::rendered_unit, ioerror
                
        call library_init()
        
        method = tls_server_method()
        ctx = ctx_new(method)

        if(.not. C_ASSOCIATED(ctx)) then
            call write_log("Context failed", LOG_NORMAL)
            return
        end if

        ! Seems to be a dummy now...
        !res = ctx_set_ecdh_auto(ctx, 1)

        if(.not. ctx_use_certificate_file(ctx, trim(pubcert), SSL_FILETYPE_PEM)) then
            call write_log("Cert file failed", LOG_NORMAL)
            call write_log("Public: "//trim(pubcert), LOG_NORMAL)
            !call print_error()
            return
        end if

        if(.not. ctx_use_private_key_file(ctx, trim(privcert), SSL_FILETYPE_PEM)) then
            call write_log("Cert file failed", LOG_NORMAL)
            call write_log("Private: "//trim(privcert), LOG_NORMAL)
            !call print_error()
            return
        end if

        ssl = ssl_new(ctx)

        call write_log("Initiating connection", LOG_DEBUG)

        ! So this is a GNU Extension...
        res = set_read_fd(ssl, fnum(input_unit))
        if(res /= 1) then
            call write_log("set rfd failed", LOG_NORMAL)
            !call print_error()
            return
        end if

        res = set_write_fd(ssl, fnum(output_unit))
        if(res /= 1) then
            call write_log("set wfd failed", LOG_NORMAL)
            !call print_error()
            return
        end if

        res = ssl_accept(ssl)
        if(res <= 0) then
            call write_log("ssl_accept failed", LOG_NORMAL)
            !call print_error()
            return
        end if

        call write_log("Handling read_request", LOG_DEBUG)

        ! Do the actual protocol nonsense
        call read_request(ssl, text_request)
        
        call write_log("Initializing object", LOG_DEBUG)
        call req%init(text_request)

        call write_log("Request object created", LOG_DEBUG)

        call req%path_component(1, first)
        if(trim(first) == 'api') then
            call write_log("API call encountered", LOG_DEBUG)
            
            if(req%protocol == "gemini") then
                resp = api_request_gemini(req)
                call write_log("resp filename is: '"//trim(resp%body_filename)//"'", LOG_DEBUG)
            else if(req%protocol == "titan") then
                call treq%init_from_request(req, ssl)
                resp = api_request_titan(treq)
            end if
            
        else 
            
            ! Check for leading session
            if(first(1:8) == "session-") then 
            
                ! Set the token in the request to the leading session id
                call req%set_token(first(9:len(first)))
                
                ! Remove the first path component
                call req%remove_first_path_component()
                
            end if
        
        
            if(req%protocol == "gemini") then
                resp = external_request_gemini(req)
            else if(req%protocol == "titan") then
                call treq%init_from_request(req, ssl)
                resp = external_request_titan(treq)
            end if
            
        end if
        
        call write_log("Handling response", LOG_DEBUG)
        ! Handle the response
        select case(resp%code)
            case(GEMINI_CODE_INPUT, GEMINI_CODE_INPUT_PW)
                call write_input_request(ssl, resp%message, code=resp%code)
                
            case(GEMINI_CODE_REDIRECT)
                call write_redirect(ssl, resp%url)
                
            case(GEMINI_CODE_PERMFAIL)
                call write_failure(ssl)
                
            case(GEMINI_CODE_SUCCESS)
                call write_log("Sending '"//trim(resp%body_filename)//"' as "//trim(resp%body_mimetype), LOG_DEBUG)
                open(newunit=rendered_unit, file=resp%body_filename, status="old", &
                     form="unformatted", iostat=ioerror, access="stream")
                call write_file(ssl, rendered_unit, resp%body_mimetype)
                call write_log("File written", LOG_DEBUG)
                close(rendered_unit)
                
        end select

        call write_log("Cleanup", LOG_DEBUG)

        call req%destroy()
        call resp%destroy()
        
        call write_log("Shutdown", LOG_DEBUG)
        res = ssl_shutdown(ssl)
        res = ssl_free(ssl)
        res = ctx_free(ctx)
    
    end subroutine handle_request

end module gemini