aboutsummaryrefslogtreecommitdiff
path: root/protocol.f90
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2020-05-21 12:25:14 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2020-05-21 12:25:14 -0400
commitf32d7d30c9cd38544349697e475355e8a2e2a478 (patch)
tree20538809141ec6dfb6954ae7d892680d13c138fe /protocol.f90
parentf46daf7de9884e32c8141ef761940f8f0a6e0249 (diff)
downloadLR-87-f32d7d30c9cd38544349697e475355e8a2e2a478.zip
LR-87-f32d7d30c9cd38544349697e475355e8a2e2a478.tar.gz
Binary files are now actually handled in the dumb terminal version.
Diffstat (limited to 'protocol.f90')
-rw-r--r--protocol.f90144
1 files changed, 113 insertions, 31 deletions
diff --git a/protocol.f90 b/protocol.f90
index 78f11c8..881314b 100644
--- a/protocol.f90
+++ b/protocol.f90
@@ -37,53 +37,66 @@ implicit none
integer, parameter::gemini_default_port = 1965
contains
-
- subroutine read_mimetype(unit_number, return_type)
+
+ subroutine get_mimetype(status_line, return_type)
implicit none
- integer, intent(in)::unit_number
+
+ character(*), intent(in)::status_line
character(*), intent(out)::return_type
- character::c
- integer::iostatus, i
+ integer::i, j
return_type = " "
! Advance past status and space
- read(unit_number, '(A1)', advance='no', iostat=iostatus) c
- do while(c /= " " .and. c /= char(9) .and. iostatus == 0)
- read(unit_number, '(A1)', advance='no', iostat=iostatus) c
+ i = 1
+ do while(status_line(i:i) /= " " .and. status_line(i:i) /= char(9) .and. i < len_trim(status_line))
+ i = i + 1
end do
- do while((c == " " .or. c == char(9)) .and. iostatus == 0)
- read(unit_number, '(A1)', advance='no', iostat=iostatus) c
+ do while((status_line(i:i) == " " .or. status_line(i:i) == char(9)) .and. i < len_trim(status_line))
+ i = i + 1
+ end do
+
+ j = 0
+ do while(.not. any([char(13), char(10)] == status_line(i:i)))
+ j = j + 1
+ return_type(j:j) = status_line(i:i)
+ i = i + 1
end do
- if(iostatus == 0) then
- ! c now contains the first entry of the mimetype
- i = 0
- do while(iostatus == 0)
- i = i + 1
- return_type(i:i) = c
- read(unit_number, '(A1)', advance='no', iostat=iostatus) c
- end do
-
- end if
-
! Default
if(len_trim(return_type) == 0) then
return_type = "text/gemini"
end if
- end subroutine read_mimetype
+ end subroutine get_mimetype
+
+ function get_return_code(status_line) result(ret)
+ implicit none
+
+ integer::ret
+ character(*), intent(in)::status_line
+ integer::istatus
+
+ read(status_line, '(i1)', iostat=istatus) ret
+
+ if(istatus /= 0) then
+ ret = STATUS_BADRESPONSE
+ end if
+
+ end function get_return_code
- function request_url(url, unit_number, return_type, server_name) result(returncode)
+ function request_url(url, unit_number, return_type, bh, server_name) result(returncode)
use request
use iso_c_binding
use file_handling, only: mark_file_end
+ use binary, only: binary_handler, is_binary_file, binary_okay
implicit none
character(*), intent(inout)::url
integer, intent(in)::unit_number
character(*), intent(out)::return_type
+ class(binary_handler)::bh
character(*), intent(in), optional::server_name
integer::port
@@ -93,9 +106,18 @@ contains
type(connection)::conn
- integer::bytes_received, i, iostatus
+ integer::bytes_received, i
character, dimension(BUFFER_SIZE)::buffer
+ ! In case we encounter a mime type we don't handle, we'll try to save it...
+ integer::binary_unit, binary_status
+ logical::binary_file
+
+ ! For direct processing of the reponse line
+ integer::response_line_index
+ character(1024)::response_line
+ logical::response_line_completed
+
returncode = -1
rewind(unit_number)
@@ -118,25 +140,85 @@ contains
if(conn%code == CONNECTION_OPEN) then
if(send_string(conn%ssl, trim(url)//c_carriage_return//c_new_line, trimming=.false.)) then
+ response_line_completed = .false.
+ response_line = " "
+ response_line_index = 0
+ binary_unit = 0
+ binary_file = .false.
+
bytes_received = retrieve_characters(conn%ssl, buffer)
do while(bytes_received > 0)
do i=1, bytes_received
- write(unit_number, '(A1)', advance='no') buffer(i)
+
+ if(.not. response_line_completed) then
+ response_line_index = response_line_index + 1
+ response_line(response_line_index:response_line_index) = buffer(i)
+
+ ! If we encountered our first newline, we have a complete status
+ ! line - handle it here
+ if(buffer(i) == char(10) .or. response_line_index == 1024) then
+ response_line_completed = .true.
+
+ returncode = get_return_code(response_line)
+
+ if(returncode == STATUS_SUCCESS) then
+
+ call get_mimetype(response_line, return_type)
+ binary_file = is_binary_file(return_type)
+
+ if(binary_file) then
+ binary_unit = bh%handle_binary(return_type, trim(url), binary_status)
+ end if
+
+ else
+
+ ! If it's not success, the rest of the code needs this line
+ ! To avoid spaces, we'll do this manually (rather than construct
+ ! a Fortran format string)
+ do response_line_index = 1, len_trim(response_line)
+ write(unit_number, '(A1)', advance='no') &
+ response_line(response_line_index:response_line_index)
+ end do
+ write(unit_number, '(A2)', advance='no') char(13)//char(10)
+
+ end if
+
+ end if
+
+ else if(binary_file .and. binary_status == binary_okay) then
+
+ write(binary_unit, '(A1)', advance='no') buffer(i)
+
+ else if(.not. binary_file) then
+
+ write(unit_number, '(A1)', advance='no') buffer(i)
+
+ end if
+
end do
bytes_received = retrieve_characters(conn%ssl, buffer)
end do
+ ! Done with bytes. If a binary file...
+ if(binary_file) then
+
+ if(binary_status == binary_okay) then
+ close(binary_unit)
+ write(unit_number, *) "Binary file completed"
+ else
+ write(unit_number, *) "Binary file ignored"
+ end if
+
+ ! For now, just reset to gemini
+ return_type = "text/gemini"
+
+ end if
+
call mark_file_end(unit_number)
rewind(unit_number)
- read(unit_number, '(I1)', iostat=iostatus, advance='no') returncode
- if(iostatus /= 0) then
- returncode = STATUS_BADRESPONSE
- else
- call read_mimetype(unit_number, return_type)
- end if
else