diff options
Diffstat (limited to 'captain')
| -rw-r--r-- | captain/external.f90 | 2 | ||||
| -rw-r--r-- | captain/gemini.f90 | 19 | ||||
| -rw-r--r-- | captain/queryutils.f90 | 6 | ||||
| -rw-r--r-- | captain/response.f90 | 315 | ||||
| -rw-r--r-- | captain/web.f90 | 39 |
5 files changed, 221 insertions, 160 deletions
diff --git a/captain/external.f90 b/captain/external.f90 index 2f7041e..766bd2e 100644 --- a/captain/external.f90 +++ b/captain/external.f90 @@ -1031,8 +1031,10 @@ contains proceed_to_create_filename = .false. + call write_log("Validating token...") proceed_to_create_filename = validate_titan_token(req%token) + call write_log("Proceeding...") if(proceed_to_create_filename) then fullpath => get_full_filename_from_request(req) end if 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..d6fa0e6 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 @@ -143,7 +144,6 @@ contains class(query), intent(out)::self character::separator character(len=*), intent(in), optional::str - character(64)::msg integer::ampersands, i, i_end, i_comp, n @@ -176,12 +176,12 @@ contains else i_comp = 1 i = 1 - i_end = index(self%full, '&') + i_end = index(self%full, separator) do while(i_comp < ampersands + 1) call self%components(i_comp)%parse(self%full(i:i_end-1)) i = i_end + 1 do i_end = i, len_trim(self%full) - if(self%full(i_end:i_end) == '&') then + if(self%full(i_end:i_end) == separator) then exit end if end do diff --git a/captain/response.f90 b/captain/response.f90 index 02ed6dd..49f735e 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,41 @@ 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 + i = index(fullurl, "://") + if(i >= 1) then allocate(character(len=(i-1)) :: self%protocol) - self%protocol = str(1:i-1) + self%protocol = fullurl(1:i-1) i = i + 3 + call write_log("Protocol: "//self%protocol, LOG_DEBUG) + else + i = 1 end if - 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 +229,15 @@ 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) - 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) 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,14 +249,9 @@ 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) + call self%q%init_with_separator(query_separator, self%query_string) if(associated(self%q%get_value("token"))) then self%token => self%q%get_value("token") @@ -250,15 +260,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 +299,75 @@ 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 + use utilities, only: toupper + 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, passurl + + fullurl = " " + + if(present(server_explicit)) then + if(index(str, server_explicit) == 1) then + passurl = str(len_trim(server_explicit)+1:len_trim(str)) + else + passurl = str + end if + else + passurl = str + end if + + call self%request%init_basics(passurl, "?", "&") + + allocate(character(len=4)::self%protocol) + self%protocol = "http" + + if(present(server_explicit)) then + allocate(character(len=len_trim(server_explicit)) :: self%server) + self%server = server_explicit + end if + + 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 +503,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 +513,7 @@ contains function request_is_post(self) result(res) implicit none - class(request)::self + class(http_request)::self logical::res res = (self%method == "POST") @@ -477,22 +547,22 @@ contains implicit none 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 @@ -500,7 +570,7 @@ contains implicit none class(request), intent(inout)::self - character(len=:), pointer::first, newloc + character(len=:), pointer::newloc integer::i, j, n @@ -563,10 +633,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 +807,29 @@ 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) + use logging 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() + integer::ierr - self%query_string => regular_request%query_string - i = index(regular_request%location, ";") - allocate(character(len=(i-1)) :: self%location) - self%location = regular_request%location(1:i-1) + call self%request%init_basics(str, ";", ";") - size_text => titan_get_request_value(regular_request%location, "size") - read(size_text, '(I16)', iostat=ierr) self%size - if(ierr /= 0) then - self%size = 0 + size_text => self%q%get_value("size") + if(associated(size_text)) then + read(size_text, '(I16)', iostat=ierr) self%size + if(ierr /= 0) then + self%size = 0 + end if 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 +839,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 0bd21ee..3b94379 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,20 +93,27 @@ 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 - character(len=:), allocatable::url, script_name, cookie + type(http_request), intent(out)::req + character(len=:), allocatable::url, script_name, cookie, server_name, fullurl character(len=4)::method - integer::url_size, cookie_size + integer::url_size, cookie_size, sn_size call get_environment_variable("REQUEST_URI", length=url_size) - allocate(character(len=url_size)::url, script_name) + allocate(character(len=url_size)::url) call get_environment_variable("REQUEST_URI", url) + + call get_environment_variable("SCRIPT_NAME", length=sn_size) + allocate(character(len=sn_size)::script_name) call get_environment_variable("SCRIPT_NAME", script_name) + call get_environment_variable("SERVER_NAME", length=sn_size) + allocate(character(len=sn_size)::server_name) + call get_environment_variable("SERVER_NAME", server_name) + call get_environment_variable("REQUEST_METHOD", method) call get_environment_variable("HTTP_COOKIE", length=cookie_size) @@ -117,6 +124,15 @@ contains end if ! If we're in CGI mode, treat the "server" as the script name + call write_log("URL IS "//trim(url), level=LOG_DEBUG) + call write_log("SE IS "//trim(script_name), level=LOG_DEBUG) + + ! We don't actually use this fabircated URL, but it is helpful for debugging + ! whatever the hell is going on when the request object is built... + allocate(character(len=(len_trim(server_name) + len_trim(url) + 7)) :: fullurl) + fullurl = "http://"//trim(server_name)//trim(url) + call write_log("FULL URL WOULD BE "//trim(fullurl), level=LOG_DEBUG) + if(allocated(cookie)) then call req%init(url, server_explicit=script_name, protocol_explicit="http", method=method, cookiestring=cookie) deallocate(cookie) @@ -126,6 +142,7 @@ contains deallocate(url) deallocate(script_name) + deallocate(server_name) end subroutine build_request_object @@ -1025,7 +1042,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 @@ -1218,13 +1235,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 @@ -1305,7 +1322,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 @@ -1314,7 +1331,7 @@ contains use utilities, only: echo_file_stdout implicit none - type(request)::req + type(http_request)::req type(response)::resp integer::response_size |