diff options
author | Jeffrey Armstrong <jeff@approximatrix.com> | 2022-05-02 11:15:59 -0400 |
---|---|---|
committer | Jeffrey Armstrong <jeff@approximatrix.com> | 2022-05-02 11:15:59 -0400 |
commit | d26549e79053413bf82c510c6fb192289fe7448a (patch) | |
tree | 107f76ff094790df116666292fb3dcfcba97a14c /captain/response.f90 | |
parent | 8c401f9748069eb052f5ac4f2eee1761b1f67afd (diff) | |
download | levitating-d26549e79053413bf82c510c6fb192289fe7448a.tar.gz levitating-d26549e79053413bf82c510c6fb192289fe7448a.zip |
Added concept of cookies so that sessions could exist in the web interface. Login and logout now work properly.
Diffstat (limited to 'captain/response.f90')
-rw-r--r-- | captain/response.f90 | 74 |
1 files changed, 71 insertions, 3 deletions
diff --git a/captain/response.f90 b/captain/response.f90 index 3933eb8..34c537c 100644 --- a/captain/response.f90 +++ b/captain/response.f90 @@ -47,6 +47,8 @@ implicit none logical::temporary_file = .false. character(len=:), pointer::body_filename => null() character(len=64)::body_mimetype + + character(len=:), pointer::cookiecmd => null() contains @@ -55,6 +57,8 @@ implicit none procedure :: set_url => response_set_url procedure :: set_body_contents => response_temp_file_contents procedure :: set_filename => response_set_filename_using_allocation + procedure :: set_cookie_cmd => response_set_cookie_cmd + procedure :: set_cookie => response_set_cookie end type @@ -70,6 +74,7 @@ implicit none character(len=4)::method = "GET" type(query)::q + type(cookies)::c contains @@ -103,14 +108,14 @@ implicit none contains - subroutine request_init(self, str, server_explicit, protocol_explicit, method) + subroutine request_init(self, str, server_explicit, protocol_explicit, method, cookiestring) use logging use utilities, only: toupper implicit none class(request) :: self character(*), intent(in)::str - character(*), intent(in), optional::server_explicit, protocol_explicit, method + character(*), intent(in), optional::server_explicit, protocol_explicit, method, cookiestring character(len=:), allocatable::temppage integer::i, j, n @@ -204,10 +209,21 @@ contains if(associated(self%query_string)) then call self%q%init(self%query_string) + + if(associated(self%q%get_value("token"))) then + self%token => self%q%get_value("token") + end if else 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 + end if + end subroutine request_init function request_component_start_location(self, i_component) result(res) @@ -416,6 +432,7 @@ contains end if call self%q%destroy() + call self%c%destroy() end subroutine request_destroy @@ -439,9 +456,58 @@ contains end if deallocate(resp%body_filename) end if + + if(associated(resp%cookiecmd)) then + deallocate(resp%cookiecmd) + end if end subroutine response_destroy + subroutine response_set_cookie_cmd(resp, str) + implicit none + + class(response)::resp + character(*), intent(in)::str + + integer::newlength + character(len=:), pointer::tmp + + if(len_trim(str) > 0) then + if(associated(resp%cookiecmd)) then + newlength = len(resp%cookiecmd)+len_trim(str)+1 + allocate(character(len=newlength)::tmp) + tmp = resp%cookiecmd//new_line(' ')//trim(str) + deallocate(resp%cookiecmd) + resp%cookiecmd => tmp + tmp => null() + else + allocate(character(len=len_trim(str)) :: resp%cookiecmd) + resp%cookiecmd = trim(str) + end if + end if + + end subroutine response_set_cookie_cmd + + subroutine response_set_cookie(resp, k, v, httponly) + implicit none + + class(response)::resp + character(len=*), intent(in)::k, v + logical, optional::httponly + + character(len=10)::httponly_trailing + + httponly_trailing = "; HttpOnly" + if(present(httponly)) then + if(.not. httponly) then + httponly_trailing = " " + end if + end if + + call resp%set_cookie_cmd("Set-Cookie: "//trim(k)//"="//trim(v)//"; SameSite=Strict"//trim(httponly_trailing)) + + end subroutine response_set_cookie + subroutine response_set_message(resp, str) implicit none @@ -584,7 +650,9 @@ contains deallocate(self%mimetype) end if if(associated(self%token)) then - deallocate(self%token) + if(.not. associated(self%q%get_value("token"), self%token)) then + deallocate(self%token) + end if end if call request_destroy(self) |