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 character(len=4)::method 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) call get_environment_variable("REQUEST_METHOD", method) ! 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) deallocate(url) deallocate(script_name) end subroutine build_request_object function html_link(link, label) result(res) implicit none character(*), intent(in)::link, label character(len=:), pointer::res integer::nl nl = len_trim(link) + len_trim(label) + len('') allocate(character(len=nl)::res) res = ''//trim(label)//'' end function html_link function generate_one_instuction_html(req) result(res) use captain_db use server_response use request_utils, only: get_status_utf8, render_jobs_links implicit none type(request)::req character(len=:), pointer::res integer::id_from_req character(128)::instruction_name type(job), dimension(:), pointer::jobs integer, dimension(:), pointer::players character(len=PLAYER_NAME_LENGTH), dimension(:), pointer::all_players integer::i, j, n_jobs, n_players, nsize character(len=:), pointer::job_link_text, one_link character(1)::nl = new_line(' ') character(PLAYER_NAME_LENGTH)::player_name character(4)::player_status i = index(req%page, ".html") instruction_name = req%page(1:i-1) id_from_req = get_instruction_id(trim(instruction_name)) jobs => get_jobs_for_instruction(id_from_req) if(associated(jobs)) then n_jobs = size(jobs) job_link_text => render_jobs_links(jobs, gemini_mode=.false., link_prefix="../") else n_jobs = 0 job_link_text => null() end if players => get_instruction_players(id_from_req) if(associated(players)) then n_players = size(players) else n_players = 0 end if nsize = 1024 if(n_jobs > 0) then nsize = nsize + len_trim(job_link_text) end if if(n_players > 0) then nsize = nsize + n_players*(2*PLAYER_NAME_LENGTH+64) end if nsize = nsize + get_player_count()*(2*PLAYER_NAME_LENGTH+64) allocate(character(len=nsize) :: res) res = "
"//one_link//"
" deallocate(one_link) if(n_players == 0) then res = trim(res)//nl//"No players currently can run these instructions
" else res = trim(res)//nl//"Assign a player to these instructions
"//nl//"Remove a player from these instructions
"//nl//""//scanlink//"
" deallocate(scanlink) end function generate_instructions_html function generate_players_html() result(res) use captain_db implicit none character(len=:), pointer::res character(len=PLAYER_NAME_LENGTH), dimension(:), pointer::players integer::n, i, nsize character(len=:), pointer::one_player n = get_player_count() if(n == 0) then allocate(character(len=1024) :: res) res = "None Yet" else players => get_player_names() nsize = 1024 do i = 1, size(players) nsize = nsize + 16 + 2*len_trim(players(i)) end do allocate(character(len=nsize) :: res) res = "Running on "//trim(player)//nl// & "Last update at: "//one_job%time//"
" res = trim(res)//nl//nl//"None reported yet
" end if else allocate(character(len=64) :: res) write(res, '(A20, 1X, I5)') "No record of:", job_id end if end function generate_one_job_html function generate_releases_html(req) result(res) use utilities use server_response use config implicit none type(request), intent(in)::req character(len=:), pointer::res character(len=DIR_LIST_STRING_LENGTH), dimension(:), pointer::directories character(len=DIR_LIST_STRING_LENGTH), dimension(:), pointer::files character(1024)::public_path, local_path, subpath integer::allocation_size, i character(1)::nl = new_line(' ') character(4)::folder_icon = char(240)//char(159)//char(147)//char(129) character(len=:), pointer::one_link if(.not. associated(req%query_string)) then public_path = "/releases" local_path = release_dir else if(len_trim(req%query_string) == 0) then public_path = "/releases" local_path = release_dir else call combine_paths("/releases", req%query_string, public_path) call combine_paths(release_dir, req%query_string, local_path) end if res => null() ! Easy safety check - no relative paths if(index(local_path, '..') > 0) then allocate(character(len=64)::res) res = "None Found" return end if directories => get_directories_in_directory(local_path) files => get_files_in_directory(local_path) allocation_size = 1024 if(associated(directories)) then allocation_size = allocation_size + 2 * size(directories) * (DIR_LIST_STRING_LENGTH+32) end if if(associated(files)) then allocation_size = allocation_size + 2 * size(files) * (DIR_LIST_STRING_LENGTH+32) end if allocate(character(len=allocation_size) :: res) res = "" if(i_start_jobs /= 1) then write(pager, '(I8)') max(i_start_jobs - 15, 1) res = trim(res)//'<< Newer |' end if if(i_start_jobs+14 < n) then write(pager, '(I8)') i_start_jobs + 15 res = trim(res)//' Older >>' end if res = trim(res)//"
" deallocate(linklist) end if end function generate_jobs_html function request_templated(req) result(resp) use page_template use config, only: template_filepath, project use logging 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 implicit none type(request), intent(in)::req type(response)::resp character(1024)::template_file type(template)::page character(64)::first character(len=:), pointer::contents character(128)::job_page_title call template_filepath("index.html", template_file) call write_log("Template base path is: "//trim(template_file), LOG_DEBUG) call page%init(trim(template_file)) ! Initialize with success resp%code = HTTP_CODE_SUCCESS call req%path_component(1, first) if(trim(req%location) == "/" .or. trim(req%location) == "/index.html" .or. trim(req%location) == "/home.html") then call page%assign('title', 'Home') else if(trim(req%location) == "/releases.html") then call page%assign('title', 'Releases') contents => generate_releases_html(req) call page%assign('contents', contents) else if(trim(req%location) == "/jobs.html") then call page%assign('title', 'Jobs') contents => generate_jobs_html(req) call page%assign('contents', contents) else if(trim(req%location) == "/players.html") then call page%assign('title', 'Players') contents => generate_players_html() call page%assign('contents', contents) else if(req%location(1:9) == '/players/') then else if(trim(req%location) == "/about.html") then call page%assign('title', 'About') else if(trim(req%location) == "/instructions.html") then if(associated(req%query_string) ) then if(trim(req%query_string) == "scan") then call scan_instructions_for_db() end if end if call page%assign('title', 'Build Instructions') contents => generate_instructions_html(req) call page%assign('contents', contents) else if(trim(first) == "instructions") then if(associated(req%query_string)) then call handle_instruction_command(req) end if call page%assign('title', 'Build Instructions') contents => generate_one_instuction_html(req) call page%assign('contents', contents) else if(trim(first) == "jobs") then call get_job_page_title(req, job_page_title) call page%assign('title', trim(job_page_title)) contents => generate_one_job_html(req) call page%assign('contents', contents) else call page%assign('title', 'Not Found') resp%code = HTTP_CODE_NOTFOUND end if call page%assign('project', project) call page%assign('base_url', req%server) call write_log("Rendering page for "//req%location) call page%render() call write_log("Finalizing response", LOG_INFO) resp%temporary_file = .true. resp%body_filename => page%output_filename resp%body_mimetype = "text/html" end function request_templated function handle_post(req) result(resp) use captain_db, only: add_player_db use page_template use config, only: template_filepath use logging use server_response, only:request, response use http, only: HTTP_CODE_FAILURE, HTTP_CODE_SUCCESS use http_post_utilities use query_utilities, only: query implicit none type(request), intent(in)::req type(response)::resp type(query)::posted character(1024)::template_file type(template)::page character(64)::category, second posted = read_post_contents() call write_log("Post Contents: "//posted%full, LOG_DEBUG) if(posted%component_count() > 0) then ! We will immediately redirect after the command is handled call template_filepath("redirect.html", template_file) call page%init(trim(template_file)) ! Handle based on category call req%path_component(1, category) if(trim(category) == "players") then call req%path_component(2, second) ! Add a player if(trim(second) == "add.html") then call add_player_db(posted%get_value("name")) call page%assign('destination', 'players.html') end if end if ! Handle the template call page%assign('base_url', req%server) call page%render() call write_log("Finalizing response", LOG_INFO) resp%temporary_file = .true. resp%body_filename => page%output_filename resp%body_mimetype = "text/html" resp%code = HTTP_CODE_SUCCESS call posted%destroy() else resp%code = HTTP_CODE_FAILURE end if end function handle_post 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 character(64)::logresponse call build_request_object(req) if(is_request_static(req)) then call write_log("Req static", LOG_INFO) resp = request_static(req) else if(req%is_post()) then call write_log("POST operation", LOG_INFO) resp = handle_post(req) else call write_log("Req template", LOG_INFO) resp = request_templated(req) end if ! Perform the response call write_log("Publishing response", LOG_INFO) write(logresponse, *) "Response code is: ", resp%code call write_log(trim(logresponse), LOG_INFO) 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) case(HTTP_CODE_FAILURE) call write_log("Failure reported for location: "//trim(req%location), LOG_NORMAL) ! Need some more... end select call write_log("Cleanup", LOG_INFO) call resp%destroy() call req%destroy() call write_log("Exit handler", LOG_INFO) end subroutine handle_request end module web