Initial import

1 files changed, 474 insertions, 0 deletions

diff --git a/common/protocol.f90 b/common/protocol.f90
new file mode 100644
index 0000000..be6f280
--- /dev/null
+++ b/common/protocol.f90
@@ -0,0 +1,474 @@
+! 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 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_BADRESPONSE  = 7
+    integer, parameter::STATUS_LOCALFAIL    = -1
+    integer, parameter::STATUS_CONNECTFAIL  = -2
+    integer, parameter::STATUS_PROTOCOLFAIL = -3
+
+    integer, parameter::BUFFER_SIZE = 256
+    
+    integer, parameter::gemini_default_port = 1965
+
+contains
+    
+    function is_failure_code(return_code)
+    implicit none
+    
+        integer, intent(in)::return_code
+        logical::is_failure_code
+        
+        is_failure_code = any(return_code == &
+            [STATUS_CONNECTFAIL, &
+             STATUS_LOCALFAIL, &
+             STATUS_BADRESPONSE, &
+             STATUS_PERMFAIL, &
+             STATUS_TEMPFAIL, &
+             STATUS_PROTOCOLFAIL])
+
+    end function is_failure_code
+    
+    subroutine get_mimetype(status_line, return_type)
+    implicit none
+    
+        character(*), intent(in)::status_line
+        character(*), intent(out)::return_type
+        
+        integer::i, j
+        
+        return_type = " "
+        
+        ! Advance past status and space
+        i = 1
+        do while(status_line(i:i) /= " " .and. status_line(i:i) /= char(9) .and. i < len_trim(status_line))
+            i = i + 1
+        end do
+        do while((status_line(i:i) == " " .or. status_line(i:i) == char(9)) .and. i < len_trim(status_line))
+            i = i + 1
+        end do
+        
+        j = 0
+        do while(.not. any([char(13), char(10)] == status_line(i:i)))
+            j = j + 1
+            return_type(j:j) = status_line(i:i)
+            i = i + 1
+        end do
+        
+        ! Default
+        if(len_trim(return_type) == 0) then
+            return_type = "text/gemini"
+        end if
+    
+    end subroutine get_mimetype
+    
+    function get_return_code(status_line) result(ret)
+    implicit none
+    
+        integer::ret
+        character(*), intent(in)::status_line
+        integer::istatus
+        
+        read(status_line, '(i1)', iostat=istatus) ret
+        
+        if(istatus /= 0) then 
+            ret = STATUS_BADRESPONSE
+        end if
+        
+    end function get_return_code
+
+    function request_url(url, unit_number, return_type) result(returncode)
+    use request
+    use iso_c_binding
+    implicit none
+    
+        character(*), intent(inout)::url
+        integer, intent(in)::unit_number
+        character(*), intent(out)::return_type
+        integer::port
+        
+        integer::returncode
+        
+        character(:), allocatable::server
+        
+        type(connection)::conn
+        
+        integer::bytes_received, i
+        character, dimension(BUFFER_SIZE)::buffer
+        
+        ! For direct processing of the reponse line
+        integer::response_line_index
+        character(1024)::response_line
+        logical::response_line_completed
+        
+        returncode = -1
+        rewind(unit_number)
+        
+
+        allocate(character(len=len_trim(url)) :: server)
+        call get_server_from_url(url, server, port)
+        if(port < 0) then
+            port = gemini_default_port
+        end if
+    
+        ! Correct URL relative paths
+        call fix_url_relative_paths(url)
+    
+        conn = open_connection(server)
+        
+        if(conn%code == CONNECTION_OPEN) then
+            if(send_string(conn%ssl, trim(url)//c_carriage_return//c_new_line, trimming=.false.)) then
+                
+                response_line_completed = .false.
+                response_line = " "
+                response_line_index = 0
+                
+                bytes_received = retrieve_characters(conn%ssl, buffer)
+                do while(bytes_received > 0)
+                
+                    do i=1, bytes_received
+                        
+                        if(.not. response_line_completed) then
+                            response_line_index = response_line_index + 1
+                            response_line(response_line_index:response_line_index) = buffer(i)
+                            
+                            ! If we encountered our first newline, we have a complete status
+                            ! line - handle it here
+                            if(buffer(i) == char(10) .or. response_line_index == 1024) then
+                                response_line_completed = .true.
+                                
+                                returncode = get_return_code(response_line)
+                                
+                                if(returncode == STATUS_SUCCESS) then
+                                
+                                    call get_mimetype(response_line, return_type)
+
+                                else
+                                
+                                    exit
+
+                                end if
+                                
+                            end if
+                            
+                        else
+                        
+                            write(unit_number) buffer(i)
+
+                        end if
+
+                    end do
+
+                    bytes_received = retrieve_characters(conn%ssl, buffer)
+                end do
+                
+            else
+            
+                returncode = STATUS_CONNECTFAIL
+                
+            end if
+            
+        else
+        
+            returncode = STATUS_CONNECTFAIL
+            
+        end if
+        
+        call close_connection(conn)
+    
+    end function request_url
+
+    function titan_post_url(url, unit_number, file_length, token, is_plain_text) result(returncode)
+    use request
+    use iso_c_binding
+    use utilities, only: read_into_buffer
+    use jessl, only: ssl_write
+    implicit none
+    
+        character(*), intent(inout)::url
+        character(*), intent(in)::token
+        integer, intent(in)::unit_number
+        logical, intent(in), optional::is_plain_text
+        integer::port
+        
+        integer::returncode
+
+        integer(kind=8), intent(in)::file_length
+        
+        character(:), allocatable::server
+        character(len=16)::file_length_text
+        
+        type(connection)::conn
+        
+        character, dimension(BUFFER_SIZE)::buffer
+        logical, dimension(4)::successes
+        integer::i, ierr, bytes_read, bytes_written, total_written
+        
+        returncode = -1
+        rewind(unit_number)
+        
+        allocate(character(len=len_trim(url)) :: server)
+        call get_server_from_url(url, server, port)
+        if(port < 0) then
+            port = gemini_default_port
+        end if
+    
+        ! Correct URL relative paths
+        call fix_url_relative_paths(url)
+    
+        conn = open_connection(server)
+        
+        if(conn%code == CONNECTION_OPEN) then
+        
+            successes(1) = send_string(conn%ssl, trim(url), trimming=.false.)
+            successes(2) = send_string(conn%ssl, ";token="//trim(token), trimming=.false.)
+            
+            if(present(is_plain_text)) then
+                if(is_plain_text) then
+                    successes(3) = send_string(conn%ssl, ";mime=text/plain", trimming=.false.)
+                else
+                    successes(3) = send_string(conn%ssl, ";mime=application/octet-stream", trimming=.false.)
+                end if
+            else
+                successes(3) = send_string(conn%ssl, ";mime=application/octet-stream", trimming=.false.)
+            end if
+            
+            write(file_length_text, *) file_length
+            file_length_text = adjustl(file_length_text)
+            successes(4) = send_string(conn%ssl, ";size="//trim(file_length_text)//c_carriage_return//c_new_line, trimming=.false.)
+        
+            if(all(successes, 1)) then
+                
+                total_written = 0
+                bytes_read = read_into_buffer(unit_number, buffer)
+                do while(bytes_read > 0)
+                    bytes_written = ssl_write(conn%ssl, buffer)
+                    total_written = total_written + bytes_written
+                    bytes_read = read_into_buffer(unit_number, buffer)
+                end do
+                
+                if(total_written >= file_length) then
+                    returncode = STATUS_SUCCESS
+                else
+                    returncode = STATUS_LOCALFAIL
+                end if
+                
+            else
+            
+                returncode = STATUS_CONNECTFAIL
+                
+            end if
+            
+        else
+        
+            returncode = STATUS_CONNECTFAIL
+            
+        end if
+        
+        call close_connection(conn)
+
+    end function titan_post_url
+
+    subroutine get_redirect_url(unit_number, url)
+    implicit none
+    
+        integer, intent(in)::unit_number
+        character(*), intent(inout)::url
+        
+        character(1024)::new_url
+        character::search
+        integer::i, istat
+        
+        rewind(unit_number)
+        
+        ! Status code
+        read(unit_number, '(A1)', advance='no') search
+        read(unit_number, '(A1)', advance='no') search
+        
+        new_url = " "
+        
+        ! At least one whitespace, but whatever...
+        read(unit_number, '(A1)', advance='no') search
+        do while(search == " " .or. search == CHAR(9))
+            read(unit_number, '(A1)', advance='no', iostat=istat) search
+        end do
+        
+        ! Now search contains our first url component
+        i = 0
+        do while(search /= CHAR(13) .and. i < len(url) .and. istat == 0)
+            i = i + 1
+            new_url(i:i) = search
+            read(unit_number, '(A1)', advance='no', iostat=istat) search
+        end do
+
+        ! Process this url properly
+        if(index(new_url, "://") > 0) then
+            url = new_url
+        else
+            call handle_relative_url(url, new_url)
+        end if
+        
+    end subroutine get_redirect_url
+
+    subroutine handle_relative_url(current_url, path)
+    implicit none
+    
+        character(*), intent(inout)::current_url
+        character(*), intent(in)::path
+        
+        integer::past_protocol, first_slash, last_slash
+        
+        ! For debugging
+        ! Print *, "*** Requested path is '"//trim(path)//"'"
+        
+        past_protocol = index(current_url, "://")
+        
+        if(path(1:2) == "//") then
+            current_url = "gemini:"//path
+            
+        else if(past_protocol > 0) then
+            
+            past_protocol = past_protocol + 3
+            
+            if(path(1:1) == "/") then
+            
+                first_slash = index(current_url(past_protocol:len_trim(current_url)), "/")
+                if(first_slash < 1) then
+                    current_url = trim(current_url)//trim(path)
+                else
+                    current_url = current_url(1:(past_protocol + first_slash - 1))//path(2:len_trim(path))
+                end if
+                
+            else
+            
+                last_slash = index(current_url, "/", back=.true.)
+                if(last_slash > 0) then
+                    current_url = current_url(1:last_slash)//path
+                end if
+                
+            end if
+            
+        end if 
+
+    end subroutine handle_relative_url
+    
+    subroutine replace_text(string, pattern, replacement, once)
+    implicit none
+    
+        character(*), intent(inout)::string
+        character(*), intent(in)::pattern
+        character(*), intent(in), optional::replacement
+        logical, intent(in), optional::once
+        
+        integer::i,j
+        
+        ! Print *, "*** Replacement: string='"//trim(string)//"' Pattern='"//pattern//"'"
+        
+        i = index(string, pattern)
+        do while(i > 0) 
+            j = i + len(pattern) ! First character after match
+            
+            ! First
+            if(i == 1) then
+                if(present(replacement)) then
+                    string = replacement//string(j:len_trim(string))
+                else
+                    string = string(j:len_trim(string))
+                end if
+                
+            ! Last
+            elseif(j > len_trim(string)) then
+                if(present(replacement)) then
+                    string = string(1:i-1)//replacement
+                else
+                    string = string(1:i-1)
+                end if
+        
+            ! Middle
+            else
+                if(present(replacement)) then
+                    string = string(1:i-1)//replacement//string(j:len_trim(string))
+                else
+                    string = string(1:i-1)//string(j:len_trim(string))
+                end if
+            end if
+            
+            ! All on the same line crashes GNU Fortran...
+            if(present(once)) then
+                if(once) then
+                    exit
+                end if
+            end if
+            
+            i = index(string, pattern)
+        end do
+    
+    end subroutine replace_text
+
+    subroutine fix_url_relative_paths(url)
+    implicit none
+    
+        character(*), intent(inout)::url
+        integer::i, pattern_start
+        
+        ! These shouldn't be there
+        i = index(url, '/./')
+        if(i > 0) then
+            call replace_text(url, '/./', replacement="/")
+        end if
+            
+        ! Remove ..
+        i = index(url, '/../')
+        do while(i > 0)
+        
+            ! Need to build the pattern
+            pattern_start = i - 1
+            do while(url(pattern_start:pattern_start) /= "/" .and. pattern_start > 1)
+                pattern_start = pattern_start - 1
+            end do
+            
+            if(pattern_start == 1) then
+                ! Error state - just exit
+                exit
+            end if
+            
+            ! Check for root...
+            if(url(pattern_start-1:pattern_start) == "//") then
+                call replace_text(url, "/../", replacement="/", once=.true.)
+            else
+                call replace_text(url, url(pattern_start:i+2), once=.true.)
+            end if
+            
+            i = index(url, '/../')
+        end do
+        
+    end subroutine fix_url_relative_paths
+
+end module gemini_protocol
\ No newline at end of file