aboutsummaryrefslogtreecommitdiff
path: root/protocol.f90
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2020-05-06 08:34:27 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2020-05-06 08:34:27 -0400
commitaa6707d3e3b6e449eb6b2299091cfaefe52ae849 (patch)
tree13bc501ded6690cb4cbd1983a1c462f54efce096 /protocol.f90
parentb063cac571202757ec25f2c6e2a772684b88d4ae (diff)
downloadLR-87-aa6707d3e3b6e449eb6b2299091cfaefe52ae849.zip
LR-87-aa6707d3e3b6e449eb6b2299091cfaefe52ae849.tar.gz
Fixed silly Fortran mistakes regarding functions returning allocated strings. Added an unused history system. Fixed URL handling.
Diffstat (limited to 'protocol.f90')
-rw-r--r--protocol.f90105
1 files changed, 99 insertions, 6 deletions
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