From aa6707d3e3b6e449eb6b2299091cfaefe52ae849 Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeff@approximatrix.com>
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.

---
 protocol.f90 | 105 +++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 99 insertions(+), 6 deletions(-)

(limited to 'protocol.f90')

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
-- 
cgit v1.2.3