Added concept of cookies so that sessions could exist in the web interface. Login and logout now work properly.

6 files changed, 233 insertions, 32 deletions

diff --git a/captain/db.f90 b/captain/db.f90
index 29c5810..97c397a 100644
--- a/captain/db.f90
+++ b/captain/db.f90
@@ -1654,6 +1654,7 @@ contains
     end subroutine update_session_db
 
     function session_expired_db(session)
+    use logging
     implicit none
     
         character(len=*), intent(in)::session
@@ -1663,12 +1664,16 @@ contains
         
         session_expired_db = .true.
         
-        if(stmt%prepare(db, "SELECT COUNT(*) FROM sessions WHERE accessed < datetime('now', '-30 minutes') AND session=?") &
+        ! Statement should return the count of sessions that _has not_ expired!
+        if(stmt%prepare(db, "SELECT COUNT(*) FROM sessions WHERE accessed > datetime('now', '-30 minutes') AND session=?") &
            == SQLITE_OK) &
         then
+            
             if(stmt%bind_text(1, session) == SQLITE_OK) then
                 
                 if(stmt%step() == SQLITE_ROW) then
+                    
+                    ! If expired, the value would be 0...
                     session_expired_db = .not. (stmt%column_int(0) > 0)
                 end if
                 
@@ -1683,4 +1688,16 @@ contains
         
     end function session_expired_db
 
+    function is_valid_session_db(session)
+    implicit none
+    
+        character(len=*), intent(in)::session
+        logical::is_valid_session_db
+        
+        ! The call below will say a non-existent session is "expired," so whatever...
+        is_valid_session_db = (.not. session_expired_db(session))
+        
+    end function is_valid_session_db
+        
+
 end module captain_db
diff --git a/captain/http.f90 b/captain/http.f90
index e58f05d..9e2fca5 100644
--- a/captain/http.f90
+++ b/captain/http.f90
@@ -44,19 +44,22 @@ contains
         
     end subroutine write_status
 
-    subroutine write_response_headers(outunit, code, filesize, mimetype)
+    subroutine write_response_headers(outunit, code, filesize, mimetype, cookiecmd)
     use logging
     implicit none
     
         integer, intent(in)::outunit, code, filesize
         character(*), intent(in)::mimetype
+        character(*), intent(in), optional::cookiecmd
         
         character(16)::num_txt
         
-        character(len=128)::confirm
-        
         call write_status(outunit, code)
         
+        if(present(cookiecmd)) then
+            write(outunit, '(A)') cookiecmd
+        end if
+        
         write(num_txt, '(I16)') filesize
         write(outunit, '(A15,1X)', advance='no') "Content-Length:"
         write(outunit, *) trim(adjustl(num_txt))
diff --git a/captain/levitating-captain.prj b/captain/levitating-captain.prj
index 4a2ecbd..4af03c5 100644
--- a/captain/levitating-captain.prj
+++ b/captain/levitating-captain.prj
@@ -75,6 +75,12 @@
             "filename":"templates/index.html",
             "enabled":"1"
           },{
+            "filename":"templates/login.html",
+            "enabled":"1"
+          },{
+            "filename":"templates/profile.html",
+            "enabled":"1"
+          },{
             "filename":"templates/redirect.html",
             "enabled":"1"
           }]
@@ -187,7 +193,7 @@
       "Launch Using MPI":"false",
       "Keep Console":"true",
       "External Console":"false",
-      "Command Line Arguments":"--uuid",
+      "Command Line Arguments":"./levitating-captain -c example/levitating.conf --verify jeff password",
       "Build Before Launch":"true"
     },
     "Build Options":{
diff --git a/captain/queryutils.f90 b/captain/queryutils.f90
index c6b612b..3a736dd 100644
--- a/captain/queryutils.f90
+++ b/captain/queryutils.f90
@@ -54,6 +54,14 @@ implicit none
         
     end type query
     
+    type, extends(query) :: cookies
+    
+        contains
+    
+        procedure :: init => cookies_init
+        
+    end type cookies
+    
 contains
 
     subroutine query_component_parse(self, comptext)
@@ -128,11 +136,12 @@ contains
         
     end function query_component_has_key
     
-    subroutine query_init(self, str)
+    subroutine query_init_generic(self, separator, str)
     use logging
     implicit none
         
         class(query), intent(out)::self
+        character::separator
         character(len=*), intent(in), optional::str
         character(64)::msg
         
@@ -154,7 +163,7 @@ contains
             
             ampersands = 0
             do i = 1, len(self%full)
-                if(self%full(i:i) == '&') then
+                if(self%full(i:i) == separator) then
                     ampersands = ampersands + 1
                 end if
             end do
@@ -183,8 +192,36 @@ contains
     
         end if
     
+    end subroutine query_init_generic
+    
+    subroutine query_init(self, str)
+    implicit none
+    
+        class(query)::self
+        character(len=*), intent(in), optional::str
+        
+        if(present(str)) then
+            call query_init_generic(self, "&", str)
+        else
+            call query_init_generic(self, "&")
+        end if
+        
     end subroutine query_init
     
+    subroutine cookies_init(self, str)
+    implicit none
+    
+        class(cookies)::self
+        character(len=*), intent(in), optional::str
+        
+        if(present(str)) then
+            call query_init_generic(self, ";", str)
+        else
+            call query_init_generic(self, ";")
+        end if
+    
+    end subroutine cookies_init
+    
     pure function query_component_count(self)
     implicit none
         
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)
diff --git a/captain/web.f90 b/captain/web.f90
index 898551c..b990c1a 100644
--- a/captain/web.f90
+++ b/captain/web.f90
@@ -52,6 +52,24 @@ contains
         
     end function method
     
+    function request_is_authenticated(req)
+    use captain_db
+    use server_response
+    implicit none
+    
+        class(request), intent(in)::req
+        logical::request_is_authenticated
+        
+        request_is_authenticated = .false.
+        if(associated(req%token)) then
+            request_is_authenticated = is_valid_session_db(req%token)
+            if(request_is_authenticated) then
+                call update_session_db(req%token)
+            end if
+        end if
+    
+    end function request_is_authenticated
+    
     subroutine handle_basic_template_components(req, page)
     use server_response
     use page_template
@@ -66,19 +84,12 @@ contains
         call page%assign('project', project)
         call page%assign('base_url', req%server)
         
-        if(associated(req%token)) then
-            if(get_session_auth_db(req%token) > 0) then
-            
-                call page%assign('user_link_page', "profile")
-                call get_session_username_db(req%token, username)
-                call page%assign('user_link_text', trim(username))
-                
-            else
-
-                call page%assign('user_link_page', "login")
-                call page%assign('user_link_text', "Login")
-
-            end if
+        if(request_is_authenticated(req)) then
+        
+            call page%assign('user_link_page', "profile")
+            call get_session_username_db(req%token, username)
+            call page%assign('user_link_text', achar(240)//achar(159)//achar(152)//achar(128)//" "//trim(username))
+        
         else
         
             call page%assign('user_link_page', "login")
@@ -90,12 +101,13 @@ contains
     
     subroutine build_request_object(req)
     use server_response, only:request
+    use logging
     implicit none
     
         type(request), intent(out)::req
-        character(len=:), allocatable::url, script_name
+        character(len=:), allocatable::url, script_name, cookie
         character(len=4)::method
-        integer::url_size
+        integer::url_size, cookie_size
         
         call get_environment_variable("REQUEST_URI", length=url_size)
         allocate(character(len=url_size)::url, script_name)
@@ -103,9 +115,21 @@ contains
         call get_environment_variable("SCRIPT_NAME", script_name)
         
         call get_environment_variable("REQUEST_METHOD", method)
+        
+        call get_environment_variable("HTTP_COOKIE", length=cookie_size)
+        if(cookie_size > 0) then
+            allocate(character(len=cookie_size) :: cookie)
+            call get_environment_variable("HTTP_COOKIE", cookie)
+            call write_log("COOKIE="//cookie, LOG_DEBUG)
+        end if
 
         ! If we're in CGI mode, treat the "server" as the script name
-        call req%init(url, server_explicit=script_name, protocol_explicit="http", method=method)
+        if(allocated(cookie)) then
+            call req%init(url, server_explicit=script_name, protocol_explicit="http", method=method, cookiestring=cookie)
+            deallocate(cookie)
+        else
+            call req%init(url, server_explicit=script_name, protocol_explicit="http", method=method)
+        end if
         
         deallocate(url)
         deallocate(script_name)
@@ -936,7 +960,7 @@ contains
     use server_response, only:request, response
     use http, only: HTTP_CODE_SUCCESS, HTTP_CODE_NOTFOUND
     use request_utils, only: get_job_page_title, handle_instruction_command
-    use captain_db, only: scan_instructions_for_db, get_session_auth_db, get_session_username_db
+    use captain_db, only: scan_instructions_for_db, get_session_username_db, destroy_session_db
     use utilities, only: build_date
     implicit none
     
@@ -952,6 +976,9 @@ contains
         character(128)::job_page_title, username
         
         integer::i
+        logical::authenticated
+        
+        authenticated = request_is_authenticated(req)
         
         if(trim(req%location) == "/" .or. &
            trim(req%location) == "/index.html" .or. &
@@ -966,7 +993,23 @@ contains
         
         else if(trim(req%location) == "/login.html") then
         
-            template_to_use = "login.html"
+            if(authenticated) then
+                template_to_use = "redirect.html"
+            else
+                template_to_use = "login.html"
+            end if
+        
+        else if(trim(req%location) == "/profile.html") then
+        
+            if(authenticated) then
+                template_to_use = "profile.html"
+            else
+                template_to_use = "redirect.html"
+            end if
+        
+        else if(trim(req%location) == "/logout.html") then
+            
+            template_to_use = "redirect.html"
             
         else
         
@@ -1063,10 +1106,32 @@ contains
         else if(trim(first) == "login.html") then
         
             call page%assign('title', 'Login')
-            if(associated(req%q%get_value("failed"))) then
-                call page%assign('login_message', "Login Failed.")
+            if(authenticated) then
+                call page%assign('destination', 'home.html')
+            else 
+                if(associated(req%q%get_value("failed"))) then
+                    call page%assign('login_message', "Login Failed.")
+                end if
+            end if
+        
+        else if(trim(first) == "profile.html") then
+        
+            call page%assign('title', 'User Profile')
+            if(authenticated) then
+                call get_session_username_db(req%token, username)
+                call page%assign('username', username)
+            else
+                call page%assign('destination', 'login.html')
             end if
             
+        else if(trim(first) == "logout.html") then
+            
+            call page%assign('title', 'Logout')
+            call page%assign('destination', 'home.html')
+            if(authenticated) then
+                call destroy_session_db(req%token)
+            end if
+        
         else
         
             call page%assign('title', 'Not Found')
@@ -1150,7 +1215,8 @@ contains
             
                 ! Determine if logged in
                 if(validate_user_db(posted%get_value("username"), posted%get_value("password"))) then
-                    call page%assign('destination', "home.html?token="//create_user_session_db(posted%get_value("username")))
+                    call resp%set_cookie("token", create_user_session_db(posted%get_value("username")))
+                    call page%assign('destination', "home.html")
                 else
                     call page%assign('destination', "login.html?failed=1")
                 end if
@@ -1220,7 +1286,11 @@ contains
                 
             case(HTTP_CODE_SUCCESS)
                 inquire(file=resp%body_filename, size=response_size)
-                call write_response_headers(output_unit, resp%code, response_size, trim(resp%body_mimetype))
+                if(associated(resp%cookiecmd)) then
+                    call write_response_headers(output_unit, resp%code, response_size, trim(resp%body_mimetype), resp%cookiecmd)
+                else
+                    call write_response_headers(output_unit, resp%code, response_size, trim(resp%body_mimetype))
+                end if
                 call echo_file_stdout(resp%body_filename)
                 
             case(HTTP_CODE_FAILURE)