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/protocol.f90 | 474 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 474 insertions(+) create mode 100644 common/protocol.f90 (limited to 'common/protocol.f90') 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 +! +! 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 -- cgit v1.2.3