Fixed silly Fortran mistakes regarding functions returning allocated strings. Added an unused history system. Fixed URL handling.

7 files changed, 207 insertions, 22 deletions

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
@@ -38,6 +38,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