! Copyright (c) 2021 Approximatrix, LLC ! ! Permission is hereby granted, free of charge, to any person obtaining a copy ! of this software and associated documentation files (the "Software"), to deal ! in the Software without restriction, including without limitation the rights ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ! copies of the Software, and to permit persons to whom the Software is ! furnished to do so, subject to the following conditions: ! ! The above copyright notice and this permission notice shall be included in ! all copies or substantial portions of the Software. ! ! The Software shall be used for Good, not Evil. ! ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ! SOFTWARE. module gemini implicit none private public :: handle_request contains subroutine read_request(ssl, req) use jessl, only: ssl_read use iso_c_binding use logging implicit none type(c_ptr)::ssl character(*), intent(out)::req character, dimension(256)::buf integer::bufread integer::i, j req = " " i = 1 call sleep(1) bufread = ssl_read(ssl, buf) do while(bufread > 0) do j = 1, bufread if(buf(j) == c_new_line) then exit end if if(buf(j) /= c_carriage_return) then req(i:i) = buf(j) i = i + 1 end if end do if(j > bufread) then j = bufread end if if(buf(j) == c_new_line) then exit end if bufread = ssl_read(ssl, buf) end do call write_log("Request Read: "//trim(req), LOG_DEBUG) end subroutine read_request function read_into_buffer(unit_number, buffer, bufsize) implicit none integer, intent(in)::unit_number integer, intent(in)::bufsize character, dimension(*), intent(out)::buffer integer::read_into_buffer integer::i, ierr ierr = 0 i = 0 do while(ierr == 0 .and. i < bufsize) i = i + 1 read(unit_number, iostat=ierr) buffer(i) end do if(ierr /= 0) then i = i - 1 end if read_into_buffer = i end function read_into_buffer subroutine write_status(ssl, code, meta) use iso_c_binding, only: c_ptr, c_carriage_return, c_new_line use jessl, only: ssl_write use logging implicit none type(c_ptr)::ssl integer, intent(in)::code character(*), intent(in)::meta character(8)::int_text character(1024)::line write(int_text, '(I8)') code line = trim(adjustl(int_text))//" "//trim(meta) call write_log("Status line: '"//trim(line)//"'", LOG_DEBUG) call write_string(ssl, trim(line)//c_carriage_return//c_new_line) end subroutine write_status subroutine write_file(ssl, unit_number, mimetype) use iso_c_binding, only: c_ptr use jessl, only: ssl_write use logging use gemini_codes implicit none type(c_ptr)::ssl integer, intent(in)::unit_number character(*), intent(in)::mimetype integer, parameter::bufsize = 4096 character, dimension(bufsize)::buf integer::readlen, written call write_status(ssl, GEMINI_CODE_SUCCESS, mimetype) readlen = read_into_buffer(unit_number, buf, bufsize) do while(readlen > 0) written = ssl_write(ssl, buf(1:readlen)) readlen = read_into_buffer(unit_number, buf, bufsize) end do end subroutine write_file subroutine write_redirect(ssl, url) use iso_c_binding, only: c_ptr use gemini_codes implicit none type(c_ptr)::ssl character(*), intent(in)::url call write_status(ssl, GEMINI_CODE_REDIRECT, url) end subroutine write_redirect subroutine write_input_request(ssl, msg, code) use iso_c_binding, only: c_ptr use gemini_codes implicit none type(c_ptr)::ssl character(*), intent(in)::msg integer, intent(in), optional::code if(present(code)) then call write_status(ssl, code, msg) else call write_status(ssl, GEMINI_CODE_INPUT, msg) end if end subroutine write_input_request subroutine write_failure(ssl) use iso_c_binding, only: c_ptr use gemini_codes implicit none type(c_ptr)::ssl call write_status(ssl, GEMINI_CODE_PERMFAIL, "Not Found") end subroutine write_failure subroutine write_string(ssl, string) use jessl, only: ssl_write use iso_c_binding, only: c_ptr implicit none type(c_ptr)::ssl character(*)::string character, dimension(:), allocatable::buf integer::i allocate(buf(len(string))) do i = 1, len(string) buf(i) = string(i:i) end do i = ssl_write(ssl, buf) deallocate(buf) end subroutine write_string subroutine handle_request() use jessl use iso_c_binding use config use iso_fortran_env use external_handling, only: external_request_gemini, external_request_titan use api_handling use logging use m_uuid, only: UUID_LENGTH use server_response use gemini_codes implicit none ! For our TLS connection type(c_ptr)::ctx type(c_ptr)::method type(c_ptr)::ssl integer(kind=c_long)::res class(request), pointer::req type(gemini_request), target::greq type(titan_request), target::treq type(response)::resp ! Requested file character(1024)::text_request character(UUID_LENGTH+8)::first character(len=:), pointer::gemlink integer::rendered_unit, ioerror call library_init() method = tls_server_method() ctx = ctx_new(method) if(.not. C_ASSOCIATED(ctx)) then call write_log("Context failed", LOG_NORMAL) return end if ! Seems to be a dummy now... !res = ctx_set_ecdh_auto(ctx, 1) if(.not. ctx_use_certificate_file(ctx, trim(pubcert), SSL_FILETYPE_PEM)) then call write_log("Cert file failed", LOG_NORMAL) call write_log("Public: "//trim(pubcert), LOG_NORMAL) !call print_error() return end if if(.not. ctx_use_private_key_file(ctx, trim(privcert), SSL_FILETYPE_PEM)) then call write_log("Cert file failed", LOG_NORMAL) call write_log("Private: "//trim(privcert), LOG_NORMAL) !call print_error() return end if ssl = ssl_new(ctx) call write_log("Initiating connection", LOG_DEBUG) ! So this is a GNU Extension... res = set_read_fd(ssl, fnum(input_unit)) if(res /= 1) then call write_log("set rfd failed", LOG_NORMAL) !call print_error() return end if res = set_write_fd(ssl, fnum(output_unit)) if(res /= 1) then call write_log("set wfd failed", LOG_NORMAL) !call print_error() return end if res = ssl_accept(ssl) if(res <= 0) then call write_log("ssl_accept failed", LOG_NORMAL) !call print_error() return end if call write_log("Handling read_request", LOG_DEBUG) ! Do the actual protocol nonsense call read_request(ssl, text_request) call write_log("Initializing object", LOG_DEBUG) if(get_protocol(text_request) == "gemini") then call greq%init(text_request) req => greq else call treq%init(text_request, ssl) req => treq end if call write_log("Request object created", LOG_DEBUG) call req%path_component(1, first) if(trim(first) == 'api') then call write_log("API call encountered", LOG_DEBUG) if(req%protocol == "gemini") then resp = api_request_gemini(req) call write_log("resp filename is: '"//trim(resp%body_filename)//"'", LOG_DEBUG) else if(req%protocol == "titan") then resp = api_request_titan(treq) end if else ! Check for leading session if(first(1:8) == "session-") then ! Set the token in the request to the leading session id call req%set_token(first(9:len(first))) ! Remove the first path component call req%remove_first_path_component() end if if(req%protocol == "gemini") then resp = external_request_gemini(greq) else if(req%protocol == "titan") then resp = external_request_titan(treq) end if end if call write_log("Handling response", LOG_DEBUG) ! Handle the response select case(resp%code) case(GEMINI_CODE_INPUT, GEMINI_CODE_INPUT_PW) call write_input_request(ssl, resp%message, code=resp%code) case(GEMINI_CODE_REDIRECT) if(req%is_authenticated_user()) then gemlink => gemini_session_link_url(resp%url, req%token) call resp%set_url(gemlink) end if call write_redirect(ssl, resp%url) case(GEMINI_CODE_PERMFAIL) call write_failure(ssl) case(GEMINI_CODE_SUCCESS) call write_log("Sending '"//trim(resp%body_filename)//"' as "//trim(resp%body_mimetype), LOG_DEBUG) open(newunit=rendered_unit, file=resp%body_filename, status="old", & form="unformatted", iostat=ioerror, access="stream") call write_file(ssl, rendered_unit, resp%body_mimetype) call write_log("File written", LOG_DEBUG) close(rendered_unit) end select call write_log("Cleanup", LOG_DEBUG) call req%destroy() call resp%destroy() call write_log("Shutdown", LOG_DEBUG) res = ssl_shutdown(ssl) res = ssl_free(ssl) res = ctx_free(ctx) end subroutine handle_request end module gemini