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_LOCALFAIL = -1 integer, parameter::BUFFER_SIZE = 256 contains function request_url(url, unit_number, 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(in), optional::server_name integer::returncode character(:), allocatable::server type(connection)::conn integer::bytes_received, i 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)') returncode 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)), "/") current_url = current_url(1:(past_protocol + first_slash - 1))//path(2:len_trim(path)) 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