aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--captain/external.f902
-rw-r--r--captain/gemini.f9019
-rw-r--r--captain/queryutils.f906
-rw-r--r--captain/response.f90315
-rw-r--r--captain/web.f9039
-rw-r--r--common/utilities.F9012
6 files changed, 224 insertions, 169 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
diff --git a/common/utilities.F90 b/common/utilities.F90
index 61c5d93..d746e0f 100644
--- a/common/utilities.F90
+++ b/common/utilities.F90
@@ -573,16 +573,10 @@ contains
character(*), intent(inout)::str
integer::i
- interface
- function toupper_c(c) bind(c, name="toupper")
- use iso_c_binding
- integer(kind=c_int), value::c
- integer(kind=c_int)::toupper_c
- end function toupper_c
- end interface
-
do i=1, len_trim(str)
- str(i:i) = char(toupper_c(IACHAR(str(i:i))))
+ if(str(i:i) >= 'a' .and. str(i:i) <= 'z') then
+ str(i:i) = CHAR(ICHAR(str(i:i)) + (ICHAR('A') - ICHAR('a')))
+ end if
end do
end subroutine toupper