Initial work on the CGI interface for web access.

9 files changed, 464 insertions, 89 deletions

diff --git a/captain/captian.f90 b/captain/captian.f90
index c5443e2..4ee637e 100644
--- a/captain/captian.f90
+++ b/captain/captian.f90
@@ -25,6 +25,7 @@ use captain_db
 use config
 use logging, only: initialize_log => initialize, shutdown_log => shutdown
 use gemini, only: handle_gemini => handle_request 
+use web, only: handle_web => handle_request 
 implicit none
 
     integer::mode
@@ -42,6 +43,8 @@ implicit none
     select case(mode)
         case(MODE_GEMINI)
             call handle_gemini()
+        case(MODE_CGI_HTML)
+            call handle_web()
     end select
     
     call shutdown_db()
diff --git a/captain/external.f90 b/captain/external.f90
index 00f34ff..7b1826a 100644
--- a/captain/external.f90
+++ b/captain/external.f90
@@ -668,39 +668,6 @@ contains
         
     end function external_input_request_gemini
     
-    function is_request_static(req)
-    use server_response
-    use logging
-    implicit none
-    
-        class(request), intent(in)::req
-        logical::is_request_static
-        character(64)::first, last
-        
-        character(4)::ext
-        integer::j
-        
-        call req%path_component(1, first)
-        call req%last_component(last)
-        
-        j = index(last, ".", back=.true.)
-        if(j > 0) then
-            ext = last(j+1:len_trim(last))
-        else
-            ext = " "
-        end if
-        
-        call write_log("Static check: "//trim(first), LOG_DEBUG)
-        
-        is_request_static = ((trim(first) == "releases") .or. &
-                             (trim(first) == "uploads") .or. &
-                             (trim(first) == "results") .or. &
-                             (trim(first) == "static") .or. &
-                             (trim(first) == "favicon.txt") .or. &
-                             (trim(first) == "instructions" .and. trim(ext) == "json"))
-        
-    end function is_request_static
-    
     function is_redirect_action(req)
     use server_response
     implicit none
@@ -733,52 +700,6 @@ contains
         
     end function external_redirect_action_request_gemini
     
-    function external_request_static(req) result(resp)
-    use logging
-    use config
-    use utilities
-    use server_response
-    use special_filenames
-    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%path_component(2, filename)
-        
-        resp%body_filename => get_special_full_filename(trim(category), trim(filename))
-    
-        inquire(file=resp%body_filename, exist=exists)
-        if(.not. exists) then
-            resp%code = GEMINI_CODE_PERMFAIL
-            call write_log("File did not exist: "//resp%body_filename, LOG_NORMAL)
-        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"
-                
-            else if(index(filename, ".json") /= 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
@@ -872,6 +793,7 @@ contains
     function external_request_gemini(req) result(resp)
     use server_response
     use logging
+    use request_utils, only: is_request_static, request_static
     implicit none
     
         class(request), intent(in)::req
@@ -891,7 +813,7 @@ contains
     
         else if(is_request_static(req)) then
             call write_log("Req static", LOG_INFO)
-            resp = external_request_static(req)
+            resp = request_static(req)
     
         else 
             call write_log("Req template", LOG_INFO)
diff --git a/captain/http.f90 b/captain/http.f90
new file mode 100644
index 0000000..08f0fbd
--- /dev/null
+++ b/captain/http.f90
@@ -0,0 +1,52 @@
+module http
+implicit none
+
+    integer, parameter::HTTP_CODE_SUCCESS  = 200
+    integer, parameter::HTTP_CODE_NOTFOUND = 404
+    integer, parameter::HTTP_CODE_FAILURE  = 500
+    integer, parameter::HTTP_CODE_REDIRECT = 302
+    
+contains
+
+    subroutine write_status(outunit, code)
+    implicit none
+    
+        integer, intent(in)::outunit, code
+        write(outunit,'(A7,1X,I3)') "Status:", code
+    
+    end subroutine write_status
+
+    subroutine write_response_headers(outunit, code, filesize, mimetype)
+    implicit none
+    
+        integer, intent(in)::outunit, code, filesize
+        character(*), intent(in)::mimetype
+        
+        character(16)::num_txt
+        
+        call write_status(outunit, code)
+        
+        write(num_txt, '(I16)') filesize
+        write(outunit, '(A15,1X)', advance='no') "Content-Length:"
+        write(outunit, *) trim(adjustl(num_txt))
+        
+        write(outunit, '(A13,1X)', advance='no') "Content-Type:"
+        write(outunit, *) trim(mimetype)//new_line(' ')
+    
+    end subroutine write_response_headers
+    
+    subroutine write_redirect(outunit, code, location)
+    implicit none
+        
+        integer, intent(in)::outunit, code
+        character(*), intent(in)::location
+    
+        call write_status(outunit, code)
+        write(outunit, '(A9,1X)', advance='no') "Location:"
+        write(outunit, *) trim(location)//new_line(' ')
+    
+    end subroutine write_redirect
+    
+end module http
+
+    
\ No newline at end of file
diff --git a/captain/levitating-captain.prj b/captain/levitating-captain.prj
index 7202344..f98e72b 100644
--- a/captain/levitating-captain.prj
+++ b/captain/levitating-captain.prj
@@ -45,6 +45,9 @@
         "Files":[{
             "filename":"templates/index.gmi",
             "enabled":"1"
+          },{
+            "filename":"templates/index.html",
+            "enabled":"1"
           }]
       }],
     "Name":"+levitating-captain (levitating-captain)",
@@ -67,12 +70,18 @@
         "filename":"gemini.f90",
         "enabled":"1"
       },{
+        "filename":"http.f90",
+        "enabled":"1"
+      },{
         "filename":"launch.f90",
         "enabled":"1"
       },{
         "filename":"log.f90",
         "enabled":"1"
       },{
+        "filename":"requtils.f90",
+        "enabled":"1"
+      },{
         "filename":"response.f90",
         "enabled":"1"
       },{
@@ -84,6 +93,9 @@
       },{
         "filename":"template.f90",
         "enabled":"1"
+      },{
+        "filename":"web.f90",
+        "enabled":"1"
       }]
   },
   "Name":"levitating-captain (levitating-captain)",
diff --git a/captain/requtils.f90 b/captain/requtils.f90
new file mode 100644
index 0000000..01c4472
--- /dev/null
+++ b/captain/requtils.f90
@@ -0,0 +1,156 @@
+module request_utils
+implicit none
+
+contains
+
+    pure function success_code(req)
+    use gemini_protocol, only: GEMINI_SUCCESS => STATUS_SUCCESS
+    use http, only: HTTP_SUCCESS => HTTP_CODE_SUCCESS
+    use server_response, only: request
+    implicit none
+    
+        class(request), intent(in)::req
+        integer::success_code
+    
+        if(req%protocol == 'gemini') then
+            success_code = GEMINI_SUCCESS
+        else
+            success_code = HTTP_SUCCESS
+        end if
+        
+    end function success_code
+
+    pure function notfound_code(req)
+    use gemini_protocol, only: GEMINI_FAIL => STATUS_PERMFAIL
+    use http, only: HTTP_FAIL => HTTP_CODE_NOTFOUND
+    use server_response, only: request
+    implicit none
+    
+        class(request), intent(in)::req
+        integer::notfound_code
+    
+        if(req%protocol == 'gemini') then
+            notfound_code = GEMINI_FAIL
+        else
+            notfound_code = HTTP_FAIL
+        end if
+        
+    end function notfound_code
+
+    subroutine basic_mimetype(actual_filename, mimetype) 
+    use utilities, only: get_one_line_output_shell_command
+    implicit none
+    
+        character(*), intent(in)::actual_filename
+        character(*), intent(out)::mimetype
+        
+        logical::exists
+        
+        ! Check for gemini first since it's fake...
+        if(index(actual_filename, ".gmi") /= 0) then
+            mimetype = "text/gemini"
+            
+        else
+        
+            inquire(file=actual_filename, exist=exists)
+            if(exists) then
+            
+                call get_one_line_output_shell_command("mimetype -b "//trim(actual_filename), mimetype)
+            
+            else
+            
+                ! If it doesn't exist, use the extension dumbly
+                if(index(actual_filename, ".txt") /= 0) then
+                    mimetype = "text/plain"
+                    
+                else if(index(actual_filename, ".json") /= 0) then
+                    mimetype = "text/plain"
+                
+                else if(index(actual_filename, ".html") /= 0) then
+                    mimetype = "text/html"
+                
+                else if(index(actual_filename, ".css") /= 0) then
+                    mimetype = "text/css"
+                    
+                ! Just a catch-all, whatever...
+                else
+                    mimetype = "application/octet-stream"
+                    
+                end if
+            
+            end if
+        
+        end if
+    
+    end subroutine basic_mimetype
+
+    function is_request_static(req)
+    use server_response
+    use logging
+    implicit none
+    
+        class(request), intent(in)::req
+        logical::is_request_static
+        character(64)::first, last
+        
+        character(4)::ext
+        integer::j
+        
+        call req%path_component(1, first)
+        call req%last_component(last)
+        
+        j = index(last, ".", back=.true.)
+        if(j > 0) then
+            ext = last(j+1:len_trim(last))
+        else
+            ext = " "
+        end if
+        
+        call write_log("Static check: "//trim(first), LOG_DEBUG)
+        
+        is_request_static = ((trim(first) == "releases") .or. &
+                             (trim(first) == "uploads") .or. &
+                             (trim(first) == "results") .or. &
+                             (trim(first) == "static") .or. &
+                             (trim(first) == "favicon.txt") .or. &
+                             (trim(first) == "instructions" .and. trim(ext) == "json"))
+        
+    end function is_request_static
+
+    function request_static(req) result(resp)
+    use logging
+    use config
+    use utilities
+    use server_response
+    use special_filenames
+    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%path_component(2, filename)
+        
+        resp%body_filename => get_special_full_filename(trim(category), trim(filename))
+    
+        inquire(file=resp%body_filename, exist=exists)
+        if(.not. exists) then
+        
+            resp%code = notfound_code(req)
+            call write_log("File did not exist: "//resp%body_filename, LOG_NORMAL)
+            
+        else
+            
+            resp%code = success_code(req)
+            call basic_mimetype(resp%body_filename, resp%body_mimetype)
+
+        end if
+    
+    end function request_static
+
+end module request_utils
\ No newline at end of file
diff --git a/captain/response.f90 b/captain/response.f90
index 09299fc..1fc21b1 100644
--- a/captain/response.f90
+++ b/captain/response.f90
@@ -92,12 +92,13 @@ implicit none
     
 contains
 
-    subroutine request_init(self, str)
+    subroutine request_init(self, str, server_explicit, protocol_explicit)
     use logging
     implicit none
     
         class(request) :: self
         character(*), intent(in)::str
+        character(*), intent(in), optional::server_explicit, protocol_explicit
         
         integer::i, j, n
         
@@ -107,17 +108,41 @@ contains
         call write_log("URL: "//self%url, LOG_NORMAL)
         
         i = index(str, "://")
-        allocate(character(len=(i-1)) :: self%protocol)
-        self%protocol = str(1:i-1)
+        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
         call write_log("Protocol: "//self%protocol, LOG_DEBUG)
         
-        i = i + 3
-        j = index(str(i:n), "/")
-        if(j <= 0) then
-            j = len_trim(str) + 1 - i
+        ! 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))
+            
         end if
-        allocate(character(len=(j-1)) :: self%server)
-        self%server = str(i:(i+j-1))
         call write_log("Server: "//self%server//"|", LOG_DEBUG)
         
         i = j+i-1
diff --git a/captain/templates/index.html b/captain/templates/index.html
new file mode 100644
index 0000000..1bbf8f4
--- /dev/null
+++ b/captain/templates/index.html
@@ -0,0 +1,34 @@
+<html>
+    <head>
+        <title>{{ title }} - I'm Levitating!</title>
+        <link rel="stylsheet" href="/static/style.css" />
+    </head>
+    
+    <body>
+    
+        <div class="heading">
+            <div class="heading_menu">
+                <ul>
+                    <li><a href="{{ base_url }}/home.html">Home</a></li>
+                    <li><a href="{{ base_url }}/releases.html">Releases</a></li>
+                    <li><a href="{{ base_url }}/jobs.html">Jobs</a></li>
+                    <li><a href="{{ base_url }}/players.html">Players</a></li>
+                    <li><a href="{{ base_url }}/instructions.html">Instructions</a></li>
+                    <li><a href="{{ base_url }}/about.html">About</a></li>
+                </ul>
+            </div>
+            <h1>{{ title }} - I'm Levitating!</h1>
+        </div>
+        
+        <div class="content">
+            
+            {{ content }}
+        
+        </div>
+        
+        <div class="footing">
+            <p>Copyright &copy; 2021 Approximatrix, LLC</p>
+        </div>
+    
+    </body>
+</html>
\ No newline at end of file
diff --git a/captain/web.f90 b/captain/web.f90
new file mode 100644
index 0000000..0899159
--- /dev/null
+++ b/captain/web.f90
@@ -0,0 +1,108 @@
+module web
+implicit none
+
+    private
+    
+    public :: handle_request
+
+    integer, parameter::REQUEST_UNKNOWN = 0
+    integer, parameter::REQUEST_GET  = 1
+    integer, parameter::REQUEST_POST = 2
+
+contains
+
+    function method()
+    use utilities, only: toupper
+    implicit none
+    
+        integer::method
+        character(4)::method_text
+    
+        call get_environment_variable("REQUEST_METHOD", method_text)
+        call toupper(method_text)
+        if(trim(method_text) == "GET") then
+            method = REQUEST_GET
+        else if(method_text == "POST") then
+            method = REQUEST_POST
+        else
+            method = REQUEST_UNKNOWN
+        end if
+        
+    end function method
+    
+    subroutine build_request_object(req)
+    use server_response, only:request
+    
+        type(request), intent(out)::req
+        character(len=:), allocatable::url, script_name
+        integer::url_size
+        
+        call get_environment_variable("REQUEST_URI", length=url_size)
+        allocate(character(len=url_size)::url, script_name)
+        call get_environment_variable("REQUEST_URI", url)
+        call get_environment_variable("SCRIPT_NAME", script_name)
+
+        ! If we're in CGI mode, treat the "server" as the script name
+        call req%init(url, server_explicit=script_name, protocol_explicit="http")
+        
+        deallocate(url)
+        deallocate(script_name)
+        
+    end subroutine build_request_object
+
+    function request_templated(req) result(resp)
+    use server_response, only:request, response
+    implicit none
+    
+        type(request), intent(in)::req
+        type(response)::resp
+        
+        
+        
+    end function request_templated
+
+    subroutine handle_request()
+    use server_response, only:request, response
+    use logging
+    use request_utils
+    use http
+    use iso_fortran_env, only: output_unit
+    use utilities, only: echo_file_stdout
+    implicit none
+    
+        type(request)::req
+        type(response)::resp
+        integer::response_size
+        
+        call build_request_object(req)
+        
+        if(is_request_static(req)) then
+            call write_log("Req static", LOG_INFO)
+            resp = request_static(req)
+    
+        else 
+            call write_log("Req template", LOG_INFO)
+            resp = request_templated(req)
+    
+        end if
+        
+        ! Perform the response
+        select case(resp%code)
+            case(HTTP_CODE_REDIRECT)
+                call write_redirect(output_unit, resp%code, trim(resp%url))
+                
+            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))
+                call echo_file_stdout(resp%body_filename)
+                
+            ! Need some more...
+            
+        end select
+    
+        call resp%destroy()
+        call req%destroy()
+    
+    end subroutine handle_request
+
+end module web
diff --git a/common/utilities.F90 b/common/utilities.F90
index 093595b..670d48f 100644
--- a/common/utilities.F90
+++ b/common/utilities.F90
@@ -467,4 +467,67 @@ contains
     
     end function get_files_in_directory
     
+    subroutine get_one_line_output_shell_command(cmd, output, retcode)
+    implicit none
+    
+        character(*), intent(in)::cmd
+        character(*), intent(out)::output
+        integer, intent(out), optional::retcode
+        
+        integer::internal_retcode, ierr, unum
+        character(len=:), pointer::tempfilename
+        
+        tempfilename => generate_temporary_filename()
+        call execute_command_line(trim(cmd)//" > "//trim(tempfilename), &
+                                  wait=.true., &
+                                  exitstat=internal_retcode)
+        
+        if(present(retcode)) then
+            retcode = internal_retcode
+        end if
+        
+        open(newunit=unum, file=tempfilename, status="old", iostat=ierr)
+        if(ierr == 0) then
+            read(unum, '(A)') output
+            close(unum)
+        end if
+        
+        call delete_file(tempfilename)
+        deallocate(tempfilename)
+    
+    end subroutine get_one_line_output_shell_command
+    
+    subroutine toupper(str)
+    implicit none
+    
+        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))))
+        end do
+        
+    end subroutine toupper
+    
+    subroutine echo_file_stdout(filename)
+    implicit none
+    
+        character(*), intent(in)::filename
+        
+#ifdef WINDOWS
+        call execute_command_line("type "//trim(filename), wait=.true.)
+#else
+        call execute_command_line("cat "//trim(filename), wait=.true.)
+#endif
+
+    end subroutine echo_file_stdout
+    
 end module utilities
\ No newline at end of file