From f32d7d30c9cd38544349697e475355e8a2e2a478 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Thu, 21 May 2020 12:25:14 -0400 Subject: Binary files are now actually handled in the dumb terminal version. --- protocol.f90 | 144 ++++++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 113 insertions(+), 31 deletions(-) (limited to 'protocol.f90') 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 -- cgit v1.2.3