diff options
Diffstat (limited to 'captain/response.f90')
-rw-r--r-- | captain/response.f90 | 287 |
1 files changed, 155 insertions, 132 deletions
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 |