Reworked requests and responses with some derived types so that things make sense.

5 files changed, 473 insertions, 52 deletions

diff --git a/captain/config.f90 b/captain/config.f90
index dc26ef4..a56f757 100644
--- a/captain/config.f90
+++ b/captain/config.f90
@@ -22,6 +22,13 @@ implicit none
     character(*), parameter::PRIVATE_CERT_VARIABLE = "private-cert"
     character(1024)::privcert
     
+    character(*), parameter::RELEASE_DIRECTORY_VARIABLE = "release-directory"
+    character(1024)::release_dir
+    
+    character(*), parameter::UPLOAD_DIRECTORY_VARIABLE = "upload-directory"
+    character(1024)::upload_dir
+    
+    
 contains
     
     subroutine get_variable(str, v)
@@ -85,6 +92,12 @@ contains
         
         else if(cvariable == LOGFILE_VARIABLE) then
             log_filename = cvalue
+            
+        else if(cvariable == RELEASE_DIRECTORY_VARIABLE) then
+            release_dir = cvalue
+            
+        else if(cvariable == UPLOAD_DIRECTORY_VARIABLE) then
+            upload_dir = cvalue
         
         end if
         
diff --git a/captain/external.f90 b/captain/external.f90
index 3ec018f..0aefdf8 100644
--- a/captain/external.f90
+++ b/captain/external.f90
@@ -1,7 +1,6 @@
 module external_handling
 implicit none
 
-
 contains
 
     function generate_players_gemini() result(res)
@@ -44,53 +43,163 @@ contains
               new_line(res(1:1))//"=> /players/add.gmi Add Player"
         
     end function generate_players_gemini
-
-    function external_request_gemini(request) result(disk_filename)
+    
+    pure function is_input_provided_request(req)
+    use server_response, only: request
+    implicit none
+        
+        class(request), intent(in)::req
+        logical::is_input_provided_request
+        
+        is_input_provided_request = associated(req%query_string)
+        
+    end function is_input_provided_request
+    
+    pure function is_input_required_request(req)
+    use server_response, only: request
+    implicit none
+        
+        class(request), intent(in)::req
+        logical::is_input_required_request
+        
+        is_input_required_request = .false.
+        if(req%location == "/players/add.gmi") then
+            is_input_required_request = .true.
+        end if
+        
+    end function is_input_required_request
+    
+    function external_input_required_gemini(req) result(resp)
+    use server_response
+    implicit none
+    
+        class(request), intent(in)::req
+        type(response)::resp
+        
+        resp%code = GEMINI_CODE_INPUT
+        
+        if(req%location == "/players/add.gmi") then
+            call resp%set_message("Enter name of new player to add")
+        end if
+        
+    end function external_input_required_gemini
+    
+    function external_input_request_gemini(req) result(resp)
+    use server_response
+    use captain_db
+    implicit none
+    
+        class(request), intent(in)::req
+        type(response)::resp
+        
+        if(req%location == "/players/add.gmi") then
+            call add_player_db(req%query_string)
+            resp%code = GEMINI_CODE_REDIRECT
+            call resp%set_url("/players.gmi")
+            
+        end if
+        
+    end function external_input_request_gemini
+    
+    function is_request_static(req)
+    use server_response
+    implicit none
+    
+        class(request), intent(in)::req
+        logical::is_request_static
+        character(64)::first
+        
+        call req%path_component(1, first)
+        
+        is_request_static = ((first == "releases") .or. (first == "uploads"))
+        
+    end function is_request_static
+    
+    function external_request_static(req) result(resp)
+    use logging, only: write_log
+    use config
+    use utilities
+    use server_response
+    implicit none
+    
+        class(request), intent(in)::req
+        type(response)::resp
+        character(64)::category
+        character(256)::filename
+        logical::exists
+    
+        resp%temporary_file = .false.
+    
+        call req%path_component(1, category)
+        call req%last_component(filename)
+        
+        if(category == "releases") then
+            allocate(character(len=(len_trim(release_dir)+len_trim(filename)+1)) :: resp%body_filename)
+            call combine_paths(release_dir, filename, resp%body_filename)
+        else if(category == "uploads") then
+            allocate(character(len=(len_trim(release_dir)+len_trim(filename)+1)) :: resp%body_filename)
+            call combine_paths(release_dir, filename, resp%body_filename)
+        end if
+    
+        inquire(file=resp%body_filename, exist=exists)
+        if(.not. exists) then
+            resp%code = GEMINI_CODE_PERMFAIL
+        else
+            resp%code = GEMINI_CODE_SUCCESS
+            
+            if(index(filename, ".gmi") /= 0) then
+                resp%body_mimetype = "text/gemini"
+                
+            else if(index(filename, ".txt") /= 0) then
+                resp%body_mimetype = "text/plain"
+                
+            ! Just a catch-all, whatever...
+            else
+                resp%body_mimetype = "application/octet-stream"
+                
+            end if
+        end if
+    
+    end function external_request_static
+    
+    function external_request_templated(req) result(resp)
     use page_template
     use config, only: template_filepath, project
     use logging, only: write_log
+    use server_response
     implicit none
     
-        character(*), intent(in)::request
-        character(len=:), pointer::disk_filename
+        class(request), intent(in)::req
+        type(response)::resp
         character(1024)::template_file
         type(template)::page
         character(len=:), pointer::contents
     
         ! Open the base template
         call template_filepath("index.gmi", template_file)
-        
         call page%init(trim(template_file))
     
-        if(trim(request) == "/" .or. trim(request) == "/index.gmi") then
+        if(trim(req%location) == "/" .or. trim(req%location) == "/index.gmi") then
         
             call page%assign('title', 'Home')
             
-        else if(trim(request) == "/releases.gmi") then
+        else if(trim(req%location) == "/releases.gmi") then
         
             call page%assign('title', 'Releases')
         
-        else if(trim(request) == "/jobs.gmi") then
+        else if(trim(req%location) == "/jobs.gmi") then
         
             call page%assign('title', 'Jobs')
         
-        else if(trim(request) == "/players.gmi") then
+        else if(trim(req%location) == "/players.gmi") then
         
             call page%assign('title', 'Players')
             contents => generate_players_gemini()
             call page%assign('contents', contents)
             
-        else if(request(1:9) == '/players/') then
+        else if(req%location(1:9) == '/players/') then
         
-            if(trim(request) == "/players/add.gmi") then
-                
-                ! Need input!
-                
-            else
-            
-            end if
-        
-        else if(trim(request) == "/about.gmi") then
+        else if(trim(req%location) == "/about.gmi") then
         
             call page%assign('title', 'About')
             
@@ -104,8 +213,34 @@ contains
         
         call page%render()
    
-        disk_filename => page%output_filename
+        resp%temporary_file = .true.
+        resp%body_filename => page%output_filename
+        resp%body_mimetype = "text/gemini"
+        resp%code = GEMINI_CODE_SUCCESS
+        
+    end function external_request_templated
+
+    function external_request_gemini(req) result(resp)
+    use server_response
+    implicit none
+    
+        class(request), intent(in)::req
+        type(response)::resp
+    
+        if(is_input_provided_request(req)) then
+            resp = external_input_request_gemini(req)
+            
+        else if(is_input_required_request(req)) then
+            resp = external_input_required_gemini(req)
     
+        else if(is_request_static(req)) then
+            resp = external_request_static(req)
+    
+        else 
+            resp = external_request_templated(req)
+    
+        end if
+        
     end function external_request_gemini
 
 end module external_handling
\ No newline at end of file
diff --git a/captain/gemini.f90 b/captain/gemini.f90
index 841bcc4..e3b8be6 100644
--- a/captain/gemini.f90
+++ b/captain/gemini.f90
@@ -93,10 +93,28 @@ contains
     
     end function read_into_buffer
 
-    subroutine write_file(ssl, unit_number, mimetype)
+    subroutine write_status(ssl, code, meta)
     use iso_c_binding, only: c_ptr, c_carriage_return, c_new_line
     use jessl, only: ssl_write
+    implicit none
+    
+        type(c_ptr)::ssl
+        integer, intent(in)::code
+        character(*), intent(in)::meta
+        
+        character(8)::int_text
+        
+        write(int_text, *) code
+        
+        call write_string(ssl, trim(adjustl(int_text))//" "//trim(meta)//c_carriage_return//c_new_line)
+        
+    end subroutine write_status
+
+    subroutine write_file(ssl, unit_number, mimetype)
+    use iso_c_binding, only: c_ptr
+    use jessl, only: ssl_write
     use logging
+    use server_response, only: GEMINI_CODE_SUCCESS
     implicit none
     
         type(c_ptr)::ssl
@@ -105,7 +123,8 @@ contains
         character, dimension(64)::buf
         integer::buflen, written
         
-        call write_string(ssl, "20 "//trim(mimetype)//c_carriage_return//c_new_line)
+        call write_status(ssl, GEMINI_CODE_SUCCESS, mimetype)
+        !call write_string(ssl, "20 "//trim(mimetype)//c_carriage_return//c_new_line)
         
         buflen = read_into_buffer(unit_number, buf)
         do while(buflen > 0)
@@ -115,6 +134,41 @@ contains
             
     end subroutine write_file
     
+    subroutine write_redirect(ssl, url)
+    use iso_c_binding, only: c_ptr
+    use server_response, only: GEMINI_CODE_REDIRECT
+    implicit none
+        
+        type(c_ptr)::ssl
+        character(*), intent(in)::url
+        
+        call write_status(ssl, GEMINI_CODE_REDIRECT, url)
+    
+    end subroutine write_redirect
+    
+    subroutine write_input_request(ssl, msg)
+    use iso_c_binding, only: c_ptr
+    use server_response, only: GEMINI_CODE_INPUT
+    implicit none
+        
+        type(c_ptr)::ssl
+        character(*), intent(in)::msg
+        
+        call write_status(ssl, GEMINI_CODE_INPUT, msg)
+    
+    end subroutine write_input_request
+    
+    subroutine write_failure(ssl)
+    use iso_c_binding, only: c_ptr
+    use server_response, only: GEMINI_CODE_PERMFAIL
+    implicit none
+        
+        type(c_ptr)::ssl
+        
+        call write_status(ssl, GEMINI_CODE_PERMFAIL, "Not Found")
+    
+    end subroutine write_failure
+    
     subroutine write_string(ssl, string)
     use jessl, only: ssl_write
     use iso_c_binding, only: c_ptr
@@ -144,6 +198,7 @@ contains
     use iso_fortran_env
     use external_handling, only: external_request_gemini
     use logging, only: write_log
+    use server_response
     implicit none
     
         ! For our TLS connection
@@ -152,18 +207,16 @@ contains
         type(c_ptr)::ssl
         integer(kind=c_long)::res
         
-        ! Requested file
-        character(1024)::request, local_request
-        character(512)::mimetype
+        type(request)::req
+        type(response)::resp
         
-        character(len=:), pointer::filename_ptr
+        ! Requested file
+        character(1024)::text_request
                 
         integer::rendered_unit, ioerror
                 
         call library_init()
-
-        filename_ptr => null()
-
+        
         method = tls_server_method()
         ctx = ctx_new(method)
 
@@ -218,36 +271,41 @@ contains
         call write_log("Handling read_request")
 
         ! Do the actual protocol nonsense
-        call read_request(ssl, request)
-
-        call write_log("Request is "//trim(request))
+        call read_request(ssl, text_request)
         
-        call simplify_request(request, local_request)
+        call req%init(text_request)
 
-        if(len_trim(local_request) .ge. 4) then
-            if(local_request(1:4) == '/api') then
+        if(len(req%location) .ge. 4) then
+            if(req%location(1:4) == '/api') then
                 !call handle_api_request(request)
             else 
-                filename_ptr => external_request_gemini(local_request)
+                resp = external_request_gemini(req)
             end if
         else
-            filename_ptr => external_request_gemini(local_request)
+            resp = external_request_gemini(req)
         end if
         
-        if(associated(filename_ptr)) then
-            open(newunit=rendered_unit, file=trim(filename_ptr), status="old", &
-                 form="unformatted", iostat=ioerror, access="stream")
-        
-            call write_log("transferring "//trim(filename_ptr))
-            call write_file(ssl, rendered_unit, "text/gemini")
-        
-            close(rendered_unit)
-            
-            if(filename_ptr(1:5) == '/tmp/') then
-                call unlink(filename_ptr)
-            end if
-            deallocate(filename_ptr)
-        end if
+        ! Handle the response
+        select case(resp%code)
+            case(GEMINI_CODE_INPUT)
+                call write_input_request(ssl, resp%message)
+                
+            case(GEMINI_CODE_REDIRECT)
+                call write_redirect(ssl, resp%url)
+                
+            case(GEMINI_CODE_PERMFAIL)
+                call write_failure(ssl)
+                
+            case(GEMINI_CODE_SUCCESS)
+                open(newunit=rendered_unit, file=resp%body_filename, status="old", &
+                     form="unformatted", iostat=ioerror, access="stream")
+                call write_file(ssl, rendered_unit, resp%body_mimetype)
+                close(rendered_unit)
+                
+        end select
+
+        call req%destroy()
+        call resp%destroy()
     
     end subroutine handle_request
 
diff --git a/captain/levitating-captain.prj b/captain/levitating-captain.prj
index 535d37b..8618272 100644
--- a/captain/levitating-captain.prj
+++ b/captain/levitating-captain.prj
@@ -57,6 +57,9 @@
         "filename":".\\log.f90",
         "enabled":"1"
       },{
+        "filename":".\\response.f90",
+        "enabled":"1"
+      },{
         "filename":".\\sqlite.f90",
         "enabled":"1"
       },{
diff --git a/captain/response.f90 b/captain/response.f90
new file mode 100644
index 0000000..b0fe9df
--- /dev/null
+++ b/captain/response.f90
@@ -0,0 +1,212 @@
+module server_response
+
+    integer, parameter::GEMINI_CODE_INPUT    = 10
+    integer, parameter::GEMINI_CODE_SUCCESS  = 20
+    integer, parameter::GEMINI_CODE_REDIRECT = 30
+    integer, parameter::GEMINI_CODE_PERMFAIL = 50
+
+    type :: response
+    
+        integer::code
+        
+        ! Used for redirects
+        character(len=:), pointer::url => null()
+        
+        ! Used for inputs in gemini
+        character(len=:), pointer::message => null()
+        
+        logical::temporary_file = .false.
+        character(len=:), pointer::body_filename => null()
+        character(len=64)::body_mimetype
+        
+        contains
+        
+        procedure :: destroy => response_destroy
+        procedure :: set_message => response_set_message
+        procedure :: set_url => response_set_url
+        
+    end type
+    
+    type :: request
+    
+        character(len=:), pointer::url => null()
+        character(len=:), pointer::server => null()
+        character(len=:), pointer::protocol => null()
+        character(len=:), pointer::location => null()
+        character(len=:), pointer::query_string => null()
+    
+        contains
+        
+        procedure :: init => request_init
+        procedure :: destroy => request_destroy
+        procedure :: last_component => request_last_component
+        procedure :: path_component => request_component
+    
+    end type request
+    
+contains
+
+    subroutine request_init(self, str)
+    implicit none
+    
+        class(request) :: self
+        character(*), intent(in)::str
+        
+        integer::i, j, n
+        
+        n = len_trim(str)
+        allocate(character(len=n) :: self%url)
+        self%url = trim(str)
+        
+        i = index(str, "://")
+        allocate(character(len=(i-1)) :: self%protocol)
+        self%protocol = str(1:i-1)
+        
+        i = i + 3
+        j = index(str(i:n), "/")
+        allocate(character(len=(j-1)) :: self%server)
+        self%server = str(i:(i+j-1))
+        
+        i = j
+        j = index(str, "?")
+        if(j == 0) then
+            allocate(character(len=(n - i + 1)) :: self%location)
+            self%location = str(i:n)
+        else
+            allocate(character(len=(n-j)) :: self%query_string)
+            self%query_string = str(j+1:n)
+            
+            allocate(character(len=(j-i)) :: self%location)
+            self%location = str(i:j-1)
+        end if
+    
+    end subroutine request_init
+    
+    subroutine request_component(self, i_component, res)
+    implicit none
+    
+        class(request) :: self
+        integer, intent(in)::i_component
+        character(*), intent(out)::res
+        
+        integer::i, j, i_last, n
+        
+        res = " "
+        
+        n = len_trim(self%location)
+
+        j = 0
+        i = index(self%location, "/")
+        do while(i /= i_last .and. j < i_component)
+            j = j + 1
+            
+            i_last = i
+            i = index(self%location(i_last:n), "/")
+            i = i_last + i
+        end do
+        
+        ! Found
+        if(j == i_component) then
+            if(i == i_last) then
+                res = self%location(i_last+1:n)
+            else
+                res = self%location(i_last+1:i-1)
+            end if
+        end if
+        
+    end subroutine request_component
+
+    subroutine request_last_component(self, res)
+    implicit none
+    
+        class(request) :: self
+        character(*), intent(out)::res
+        
+        integer::i
+        
+        i = index(self%location, "/", back=.true.)
+        
+        if(i == len_trim(self%location)) then
+            res = "/"
+        else
+            res = self%location((i+1):len_trim(res))
+        end if
+        
+    end subroutine request_last_component
+
+    subroutine request_destroy(self)
+    implicit none
+    
+        class(request) :: self
+        
+        if(associated(self%url)) then
+            deallocate(self%url)
+        end if
+        
+        if(associated(self%server)) then
+            deallocate(self%server)
+        end if
+        
+        if(associated(self%location)) then
+            deallocate(self%location)
+        end if
+        
+        if(associated(self%query_string)) then
+            deallocate(self%query_string)
+        end if
+        
+        if(associated(self%protocol)) then
+            deallocate(self%protocol)
+        end if
+        
+    end subroutine request_destroy
+
+    subroutine response_destroy(resp)
+    implicit none
+    
+        class(response)::resp
+    
+        if(associated(resp%url)) then
+            deallocate(resp%url)
+        end if
+        
+        if(associated(resp%message)) then
+            deallocate(resp%message)
+        end if
+        
+        if(associated(resp%body_filename)) then
+            if(resp%temporary_file) then
+                call unlink(resp%body_filename)
+            end if
+            deallocate(resp%body_filename)
+        end if
+    
+    end subroutine response_destroy
+    
+    subroutine response_set_message(resp, str)
+    implicit none
+    
+        class(response)::resp
+        character(*), intent(in)::str
+        
+        if(len_trim(str) > 0) then
+            allocate(character(len=len_trim(str)) :: resp%message)
+            resp%message = trim(str)
+        end if
+    
+    end subroutine response_set_message
+    
+    subroutine response_set_url(resp, str)
+    implicit none
+    
+        class(response)::resp
+        character(*), intent(in)::str
+        
+        if(len_trim(str) > 0) then
+            allocate(character(len=len_trim(str)) :: resp%url)
+            resp%url = trim(str)
+        end if
+    
+    end subroutine response_set_url
+    
+end module server_response