From aa6707d3e3b6e449eb6b2299091cfaefe52ae849 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Wed, 6 May 2020 08:34:27 -0400 Subject: Fixed silly Fortran mistakes regarding functions returning allocated strings. Added an unused history system. Fixed URL handling. --- files.f90 | 10 ++--- gemini-windows.prj | 3 ++ history.f90 | 84 ++++++++++++++++++++++++++++++++++++++++++ jessl.f90 | 14 +++---- main.F90 | 7 +++- protocol.f90 | 105 ++++++++++++++++++++++++++++++++++++++++++++++++++--- request.f90 | 6 +-- 7 files changed, 207 insertions(+), 22 deletions(-) create mode 100644 history.f90 diff --git a/files.f90 b/files.f90 index cbdb44d..0ca43a6 100644 --- a/files.f90 +++ b/files.f90 @@ -26,10 +26,10 @@ contains end function is_file_end_marker - function read_line_text(unit_number, iostatus) result(res) + subroutine read_line_text(unit_number, res, iostatus) implicit none - character(len=:), allocatable::res + character(len=:), allocatable, intent(out)::res integer, intent(in)::unit_number integer, intent(out)::iostatus integer::startpos, endpos, length, i @@ -64,7 +64,7 @@ contains end do end if - end function read_line_text + end subroutine read_line_text subroutine process_line(single_line, file_type, preformatted_on) use layout @@ -125,7 +125,7 @@ contains allocate(first_line) - first_line%text = read_line_text(unit_number, iostatus) + call read_line_text(unit_number, first_line%text, iostatus) first_line%next => null() walker=>first_line @@ -141,7 +141,7 @@ contains next_line => null() walker => walker%next - walker%text = read_line_text(unit_number, iostatus) + call read_line_text(unit_number, walker%text, iostatus) end do diff --git a/gemini-windows.prj b/gemini-windows.prj index 79a1595..d59e44f 100644 --- a/gemini-windows.prj +++ b/gemini-windows.prj @@ -37,6 +37,9 @@ },{ "filename":".\\files.f90", "enabled":"1" + },{ + "filename":".\\history.f90", + "enabled":"1" },{ "filename":".\\layout.f90", "enabled":"1" diff --git a/history.f90 b/history.f90 new file mode 100644 index 0000000..d8193f8 --- /dev/null +++ b/history.f90 @@ -0,0 +1,84 @@ +module history +implicit none + + type :: location + character(1024)::url + type(location), pointer::next + end type + +contains + + function last_location(first_location) + implicit none + + type(location), pointer::first_location + type(location), pointer::last_location + + if(.not. associated(first_location)) then + last_location => null() + else + last_location => first_location + do while(associated(last_location%next)) + last_location => last_location%next + end do + end if + + end function last_location + + function add_location(first_location, url) result(head) + implicit none + + type(location), pointer::first_location + type(location), pointer::head + character(*), intent(in)::url + + type(location), pointer::last + + ! Check if it is our first location + if(.not. associated(first_location)) then + + allocate(first_location) + first_location%next => null() + first_location%url = url + + else + + last => last_location(first_location) + allocate(last%next) + last => last%next + last%next => null() + last%url = url + + end if + + head => first_location + + end function add_location + + subroutine back_location(first_location, url) + implicit none + + type(location), pointer::first_location + character(*), intent(out)::url + + type(location), pointer::last, new_last + + url = " " + + last => last_location(first_location) + if(associated(last)) then + url = last%url + + if(.not. associated(last, first_location)) then + new_last => first_location + do while(.not. associated(new_last%next, last)) + new_last => new_last%next + end do + new_last%next => null() + deallocate(last) + end if + end if + + end subroutine back_location + +end module history \ No newline at end of file diff --git a/jessl.f90 b/jessl.f90 index bd05d42..82d6465 100644 --- a/jessl.f90 +++ b/jessl.f90 @@ -148,11 +148,11 @@ contains end function ssl_write - function get_cipher(ssl) + subroutine get_cipher(ssl, res) use iso_c_binding implicit none - character(:), allocatable::get_cipher + character(:), allocatable, intent(out)::res type(c_ptr)::ssl type(c_ptr)::cptr @@ -164,8 +164,8 @@ contains cptr = c_null_ptr if(.not. c_associated(cptr)) then - allocate(character(len=1)::get_cipher) - get_cipher = " " + allocate(character(len=1)::res) + res = " " else @@ -175,15 +175,15 @@ contains do while(cstring(i) /= c_null_char) i = i + 1 end do - allocate(character(len=(i-1))::get_cipher) + allocate(character(len=(i-1))::res) i = 1 do while(cstring(i) /= c_null_char) - get_cipher(i:i) = cstring(i) + res(i:i) = cstring(i) end do end if - end function get_cipher + end subroutine get_cipher end module jessl diff --git a/main.F90 b/main.F90 index a457d01..f31a3ca 100644 --- a/main.F90 +++ b/main.F90 @@ -4,6 +4,7 @@ use dumb_render use gemini_protocol use layout use file_handling +use history #ifdef WINDOWS use wsa_network, only: windows_network_startup => startup @@ -25,6 +26,7 @@ implicit none integer, parameter::io = 100 type(line), pointer::first_line + type(location), pointer::locations_visited #ifdef WINDOWS call windows_network_startup() @@ -57,6 +59,7 @@ implicit none loaded = .false. call r%initialize() + locations_visited => null() current_url = initial_site open(unit=io, form="formatted", status="scratch", access='stream') @@ -74,7 +77,7 @@ implicit none call r%report_status("Requesting "//trim(current_url)) - return_code = request_url(trim(current_url), io) + return_code = request_url(current_url, io) populated = .true. call update_status(r, current_url, return_code) @@ -98,6 +101,8 @@ implicit none else if(populated) then + locations_visited => add_location(locations_visited, current_url) + first_line => load_unit(io, file_type_gemini) loaded = .true. call r%new_page() diff --git a/protocol.f90 b/protocol.f90 index 130c866..6d2390a 100644 --- a/protocol.f90 +++ b/protocol.f90 @@ -19,7 +19,7 @@ contains use file_handling, only: mark_file_end implicit none - character(*), intent(in)::url + character(*), intent(inout)::url integer, intent(in)::unit_number character(*), intent(in), optional::server_name @@ -39,13 +39,16 @@ contains allocate(character(len=len_trim(server_name)) :: server) server = server_name else - server = get_server_from_url(url) + 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, url//c_carriage_return//c_new_line, trimming=.false.)) 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) @@ -122,15 +125,21 @@ contains integer::past_protocol, first_slash, last_slash + Print *, "*** Requested path is '"//trim(path)//"'" + past_protocol = index(current_url, "://") - if(past_protocol > 0) then + + 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 + current_url = current_url(1:(past_protocol + first_slash - 1))//path(2:len_trim(path)) else @@ -141,8 +150,92 @@ contains 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 \ No newline at end of file diff --git a/request.f90 b/request.f90 index 8a4e4e5..e9784fd 100644 --- a/request.f90 +++ b/request.f90 @@ -142,11 +142,11 @@ contains end subroutine close_connection - function get_server_from_url(url) result(server) + subroutine get_server_from_url(url, server) implicit none character(*), intent(in)::url - character(:), allocatable::server + character(:), allocatable, intent(out)::server integer::start_server, end_server, length @@ -168,7 +168,7 @@ contains Print *, "server is: "//trim(server) end if - end function get_server_from_url + end subroutine get_server_from_url function send_string(ssl, str, trimming) result(success) use iso_c_binding -- cgit v1.2.3