aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--files.f9010
-rw-r--r--gemini-windows.prj3
-rw-r--r--history.f9084
-rw-r--r--jessl.f9014
-rw-r--r--main.F907
-rw-r--r--protocol.f90105
-rw-r--r--request.f906
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