! 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::BUFFER_SIZE = 256 contains subroutine read_mimetype(unit_number, return_type) implicit none integer, intent(in)::unit_number character(*), intent(out)::return_type character::c integer::iostatus, i return_type = " " ! Advance past status and space read(unit_number, '(A1)', advance='no', iostat=iostatus) c do while(c /= " " .and. c /= char(9) .and. iostatus == 0) read(unit_number, '(A1)', advance='no', iostat=iostatus) c end do do while((c == " " .or. c == char(9)) .and. iostatus == 0) read(unit_number, '(A1)', advance='no', iostat=iostatus) c end do if(iostatus == 0) then ! c now contains the first entry of the mimetype i = 0 do while(iostatus == 0) i = i + 1 return_type(i:i) = c read(unit_number, '(A1)', advance='no', iostat=iostatus) c end do end if ! Default if(len_trim(return_type) == 0) then return_type = "text/gemini" end if end subroutine read_mimetype function request_url(url, unit_number, return_type, server_name) result(returncode) use request use iso_c_binding use file_handling, only: mark_file_end implicit none character(*), intent(inout)::url integer, intent(in)::unit_number character(*), intent(out)::return_type character(*), intent(in), optional::server_name integer::returncode character(:), allocatable::server type(connection)::conn integer::bytes_received, i, iostatus character, dimension(BUFFER_SIZE)::buffer returncode = -1 rewind(unit_number) if(present(server_name)) then allocate(character(len=len_trim(server_name)) :: server) server = server_name else call get_server_from_url(url, server) 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 bytes_received = retrieve_characters(conn%ssl, buffer) do while(bytes_received > 0) do i=1, bytes_received write(unit_number, '(A1)', advance='no') buffer(i) end do bytes_received = retrieve_characters(conn%ssl, buffer) end do call mark_file_end(unit_number) rewind(unit_number) read(unit_number, '(I1)', iostat=iostatus, advance='no') returncode if(iostatus /= 0) then returncode = STATUS_BADRESPONSE else call read_mimetype(unit_number, return_type) end if else returncode = -1 write(unit_number, *) "Send Error: Could Not Send Request" write(*, *) "Send Error: Could Not Send Request" end if else returncode = -1 write(unit_number, *) "Connection Error: "//trim(translate_connection_code(conn%code)) write(*, *) "Connection Error: "//trim(translate_connection_code(conn%code)) end if call close_connection(conn) end function request_url subroutine get_redirect_url(unit_number, url) implicit none integer, intent(in)::unit_number character(*), intent(inout)::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 ! Clear the url url = repeat(" ", len(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 url(i:i) = search read(unit_number, '(A1)', advance='no', iostat=istat) search end do 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 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 if(present(once) .and. once) then exit 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 call replace_text(url, url(pattern_start:i+2), once=.true.) i = index(url, '/../') end do end subroutine fix_url_relative_paths end module gemini_protocol