diff options
| -rw-r--r-- | captain/gemini.f90 | 19 | ||||
| -rw-r--r-- | captain/queryutils.f90 | 1 | ||||
| -rw-r--r-- | captain/response.f90 | 287 | ||||
| -rw-r--r-- | captain/web.f90 | 16 |
4 files changed, 177 insertions, 146 deletions
diff --git a/captain/gemini.f90 b/captain/gemini.f90 index 7e849d6..b14078d 100644 --- a/captain/gemini.f90 +++ b/captain/gemini.f90 @@ -227,8 +227,10 @@ contains type(c_ptr)::ssl integer(kind=c_long)::res - type(request)::req - type(titan_request)::treq + class(request), pointer::req + + type(gemini_request), target::greq + type(titan_request), target::treq type(response)::resp ! Requested file @@ -297,7 +299,14 @@ contains call read_request(ssl, text_request) call write_log("Initializing object", LOG_DEBUG) - call req%init(text_request) + + 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) @@ -309,7 +318,6 @@ contains resp = api_request_gemini(req) call write_log("resp filename is: '"//trim(resp%body_filename)//"'", LOG_DEBUG) else if(req%protocol == "titan") then - call treq%init_from_request(req, ssl) resp = api_request_titan(treq) end if @@ -328,9 +336,8 @@ contains if(req%protocol == "gemini") then - resp = external_request_gemini(req) + resp = external_request_gemini(greq) else if(req%protocol == "titan") then - call treq%init_from_request(req, ssl) resp = external_request_titan(treq) end if diff --git a/captain/queryutils.f90 b/captain/queryutils.f90 index 3a736dd..c8a5d44 100644 --- a/captain/queryutils.f90 +++ b/captain/queryutils.f90 @@ -44,6 +44,7 @@ implicit none contains procedure :: init => query_init + procedure :: init_with_separator => query_init_generic procedure :: destroy => query_destroy procedure :: component_count => query_component_count procedure :: get_value_by_index => get_query_value_from_index diff --git a/captain/response.f90 b/captain/response.f90 index 02ed6dd..a82f53d 100644 --- a/captain/response.f90 +++ b/captain/response.f90 @@ -65,24 +65,20 @@ implicit none character(len=:), pointer::page => null() character(len=:), pointer::query_string => null() character(len=:), pointer::token => null() - character(len=4)::method = "GET" integer::auth_level type(query)::q - type(cookies)::c contains - procedure :: init => request_init + procedure :: init_basics => request_init procedure :: destroy => request_destroy procedure :: last_component => request_last_component procedure :: path_component => request_component procedure :: path_component_int => request_component_int procedure :: path_starting_with_component => request_component_starting_with procedure :: component => request_component_func - procedure :: is_get => request_is_get - procedure :: is_post => request_is_post procedure :: has_query => request_has_query procedure :: is_authenticated_user => request_is_authenticated_user procedure :: set_token => request_set_token @@ -91,6 +87,31 @@ implicit none end type request + type, extends(request) :: http_request + + character(len=4)::method = "GET" + + type(cookies)::c + + contains + + procedure :: init => http_request_init + procedure :: is_get => request_is_get + procedure :: is_post => request_is_post + procedure :: clear_token => http_request_clear_token + procedure :: destroy => http_request_destroy + + end type http_request + + type, extends(request) ::gemini_request + + contains + + procedure :: init => gemini_request_init + + end type gemini_request + + type, extends(request) :: titan_request integer(kind=8)::size @@ -100,7 +121,7 @@ implicit none contains - procedure :: init_from_request => titan_request_init + procedure :: init => titan_request_init procedure :: destroy => titan_request_destroy procedure :: write_to => titan_write_to_filename @@ -108,6 +129,23 @@ implicit none contains + function get_protocol(url) + implicit none + + character(len=*), intent(in)::url + character(6)::get_protocol + + integer::i + + i = index(url, "://") + if(i < 1) then + get_protocol = "gemini" + else + get_protocol = url(1:i-1) + end if + + end function get_protocol + function gemini_session_link_url(link, session_token) result(res) implicit none @@ -139,7 +177,7 @@ contains end function gemini_session_link_url - subroutine request_init(self, str, server_explicit, protocol_explicit, method, cookiestring) + subroutine request_init(self, fullurl, query_start_char, query_separator) use logging use utilities, only: toupper use captain_db, only: get_session_auth_db @@ -147,60 +185,37 @@ contains implicit none class(request) :: self - character(*), intent(in)::str - character(*), intent(in), optional::server_explicit, protocol_explicit, method, cookiestring + character(*), intent(in)::fullurl + character(len=1), intent(in)::query_start_char, query_separator character(len=:), allocatable::temppage integer::i, j, n character(64)::msg - n = len_trim(str) + n = len_trim(fullurl) allocate(character(len=n) :: self%url) - self%url = trim(str) + self%url = trim(fullurl) call write_log("URL: "//self%url, LOG_NORMAL) - i = index(str, "://") - if(i <= 0 .and. present(protocol_explicit)) then - allocate(character(len=len_trim(protocol_explicit)) :: self%protocol) - self%protocol = protocol_explicit - i = 1 - else - allocate(character(len=(i-1)) :: self%protocol) - self%protocol = str(1:i-1) - i = i + 3 - end if + i = index(fullurl, "://") + allocate(character(len=(i-1)) :: self%protocol) + self%protocol = fullurl(1:i-1) + i = i + 3 call write_log("Protocol: "//self%protocol, LOG_DEBUG) ! We only want to "assume" the server if a :// was never found - if(i == 1 .and. present(server_explicit)) then - allocate(character(len=len_trim(server_explicit)) :: self%server) - self%server = server_explicit - - ! This string, in CGI cases, actually represents the SCRIPT root, - ! so we need to skip ahead of it in the URL if it is there... - i = index(str, self%server) - if(i > 0) then - i = i + len(self%server) - else - i = 1 - end if - - else - - j = index(str(i:n), "/") - if(j <= 0) then - j = len_trim(str) + 1 - i - end if - allocate(character(len=(j-1)) :: self%server) - self%server = str(i:(i+j-1)) - - i = j+i-1 - + j = index(fullurl(i:n), "/") + if(j <= 0) then + j = len_trim(fullurl) + 1 - i end if + allocate(character(len=(j-1)) :: self%server) + self%server = fullurl(i:(i+j-1)) + + i = j+i-1 call write_log("Server: "//self%server//"|", LOG_DEBUG) - j = index(str, "?") + j = index(fullurl, query_start_char) if(j == 0) then if(n-i+1 == 0) then allocate(character(len=1) :: self%location) @@ -210,19 +225,20 @@ contains call write_log("i n: "//trim(msg), LOG_DEBUG) allocate(character(len=(n - i + 1)) :: self%location) - call write_log("str(i:n): "//str(i:n), LOG_DEBUG) - self%location = str(i:n) + self%location = fullurl(i:n) end if call write_log("Location: "//self%location, LOG_DEBUG) + call self%q%init() + else allocate(character(len=(n-j)) :: self%query_string) - self%query_string = str(j+1:n) - call write_log("Query: "//self%query_string, LOG_DEBUG) + self%query_string = fullurl(j+1:n) + + call self%q%init_with_separator(query_separator, self%query_string) allocate(character(len=(j-i)) :: self%location) - self%location = str(i:j-1) - call write_log("Location: "//self%location, LOG_DEBUG) + self%location = fullurl(i:j-1) end if ! and page, which is really just a last location if there is an extension... @@ -234,11 +250,6 @@ contains self%page = temppage end if deallocate(temppage) - - if(present(method)) then - self%method = method - call toupper(self%method) - end if if(associated(self%query_string)) then call self%q%init(self%query_string) @@ -250,15 +261,6 @@ contains call self%q%init() end if - if(present(cookiestring)) then - call self%c%init(cookiestring) - if(.not.associated(self%token) .and. associated(self%c%get_value("token"))) then - self%token => self%c%get_value("token") - end if - else - call self%c%init() - end if - if(associated(self%token)) then self%auth_level = get_session_auth_db(self%token) else @@ -298,6 +300,62 @@ contains end function request_component_start_location + subroutine gemini_request_init(self, str) + implicit none + + class(gemini_request), intent(out)::self + character(len=*), intent(in)::str + + call self%request%init_basics(str, "?", "&") + + end subroutine gemini_request_init + + subroutine http_request_init(self, str, server_explicit, protocol_explicit, method, cookiestring) + use captain_db, only: get_session_auth_db + use auth_levels, only: AUTH_NONE + implicit none + + class(http_request), intent(out)::self + character(len=*), intent(in)::str + character(*), intent(in), optional::server_explicit, protocol_explicit, method, cookiestring + + character(len=1024)::fullurl + + fullurl = " " + + if(present(protocol_explicit) .and. present(server_explicit)) then + fullurl = trim(protocol_explicit)//"://"//trim(server_explicit)//trim(str) + else + fullurl = trim(str) + end if + + call self%request%init_basics(fullurl, "?", "&") + + if(present(method)) then + self%method = method + call toupper(self%method) + else + self%method = "GET" + end if + + if(present(cookiestring)) then + call self%c%init(cookiestring) + if(.not.associated(self%token) .and. associated(self%c%get_value("token"))) then + self%token => self%c%get_value("token") + end if + else + call self%c%init() + end if + + if(associated(self%token)) then + self%auth_level = get_session_auth_db(self%token) + else + self%auth_level = AUTH_NONE + end if + + + end subroutine http_request_init + function request_is_authenticated_user(self) use captain_db implicit none @@ -433,7 +491,7 @@ contains function request_is_get(self) result(res) implicit none - class(request)::self + class(http_request)::self logical::res res = (self%method == "GET") @@ -443,7 +501,7 @@ contains function request_is_post(self) result(res) implicit none - class(request)::self + class(http_request)::self logical::res res = (self%method == "POST") @@ -478,21 +536,22 @@ contains class(request), intent(inout)::self logical::safe_to_deallocate + + self%token => null() + self%auth_level = 0 - if(associated(self%token)) then - safe_to_deallocate = .not. (associated(self%c%get_value("token"), self%token) .or. & - associated(self%q%get_value("token"), self%token)) - - if(safe_to_deallocate) then - deallocate(self%token) - end if - - end if + end subroutine request_clear_token + + subroutine http_request_clear_token(self) + implicit none + + class(http_request), intent(inout)::self self%token => null() self%auth_level = 0 - end subroutine request_clear_token + end subroutine http_request_clear_token + ! This routine is needed if we're stripping session identifiers ! in Gemini URLs @@ -563,10 +622,20 @@ contains call self%clear_token() call self%q%destroy() - call self%c%destroy() end subroutine request_destroy + subroutine http_request_destroy(self) + implicit none + + class(http_request) :: self + + call self%request%destroy() + + call self%c%destroy() + + end subroutine http_request_destroy + subroutine response_destroy(resp) use utilities, only: delete_file implicit none @@ -727,65 +796,28 @@ contains end subroutine response_set_filename_using_allocation - function titan_get_request_value( full_location, label) result(p) - implicit none - - character(*), intent(in)::full_location, label - character(len=:), pointer::p - - integer::i, j, n, label_width - - label_width = len_trim(label) - - n = len_trim(full_location) - i = index(full_location, ";"//trim(label)//"=") - j = index(full_location(i+1:n), ";") - if(j<=0) then - j = n - else - j = j+i-1 - end if - i = i + label_width + 2 - - allocate(character(len=(j-i+1))::p) - p = full_location(i:j) - - end function titan_get_request_value - - subroutine titan_request_init(self, regular_request, ssl_connection) + subroutine titan_request_init(self, str, ssl_connection) implicit none class(titan_request)::self - class(request), intent(inout)::regular_request + character(len=*), intent(in)::str type(c_ptr)::ssl_connection character(len=:), pointer::size_text integer::i, ierr - self%url => regular_request%url - regular_request%url => null() - - self%protocol => regular_request%protocol - regular_request%protocol => null() - - self%server => regular_request%server - regular_request%server => null() - self%query_string => regular_request%query_string + call self%request%init_basics(str, ";", ";") - i = index(regular_request%location, ";") - allocate(character(len=(i-1)) :: self%location) - self%location = regular_request%location(1:i-1) - - size_text => titan_get_request_value(regular_request%location, "size") + size_text => self%q%get_value("size") read(size_text, '(I16)', iostat=ierr) self%size if(ierr /= 0) then self%size = 0 end if deallocate(size_text) - self%mimetype => titan_get_request_value(regular_request%location, "mime") - self%token => titan_get_request_value(regular_request%location, "token") + self%mimetype => self%q%get_value("mime") + self%token => self%q%get_value("token") self%ssl_connection = ssl_connection @@ -795,16 +827,7 @@ contains implicit none class(titan_request)::self - - if(associated(self%mimetype)) then - deallocate(self%mimetype) - end if - if(associated(self%token)) then - if(.not. associated(self%q%get_value("token"), self%token)) then - deallocate(self%token) - end if - end if - + self%token => null() call request_destroy(self) end subroutine titan_request_destroy diff --git a/captain/web.f90 b/captain/web.f90 index e7ade4f..f808eae 100644 --- a/captain/web.f90 +++ b/captain/web.f90 @@ -70,7 +70,7 @@ contains use config implicit none - type(request), intent(in)::req + class(request), intent(in)::req type(template), intent(inout)::page character(len=128)::username @@ -93,11 +93,11 @@ contains end subroutine handle_basic_template_components subroutine build_request_object(req) - use server_response, only:request + use server_response, only:http_request use logging implicit none - type(request), intent(out)::req + type(http_request), intent(out)::req character(len=:), allocatable::url, script_name, cookie character(len=4)::method integer::url_size, cookie_size @@ -1004,7 +1004,7 @@ contains use utilities, only: build_date implicit none - type(request), intent(in)::req + class(request), intent(in)::req type(response)::resp character(64)::template_to_use @@ -1197,13 +1197,13 @@ contains use page_template use config, only: template_filepath, global_permissions use logging - use server_response, only:request, response + use server_response, only:http_request, response use http_post_utilities use query_utilities, only: query use http_codes implicit none - type(request), intent(in)::req + type(http_request), intent(in)::req type(response)::resp type(query)::posted @@ -1284,7 +1284,7 @@ contains end function handle_post subroutine handle_request() - use server_response, only:request, response + use server_response, only:http_request, response use logging use request_utils use http_codes @@ -1293,7 +1293,7 @@ contains use utilities, only: echo_file_stdout implicit none - type(request)::req + type(http_request)::req type(response)::resp integer::response_size |