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) use request_utils, only: build_link implicit none character(*), intent(in)::link, label character(len=:), pointer::res res => build_link(link, label, .false.) 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, generate_simple_pager 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, job_start_index character(len=:), pointer::job_link_text, one_link, pager 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 if(associated(req%query_string)) then read(req%query_string, *) job_start_index else job_start_index = 1 end if n_jobs = size(jobs) job_link_text => render_jobs_links(jobs, gemini_mode=.false., & link_prefix="../", startindex=job_start_index, & stopindex=min(job_start_index+4, n_jobs)) else job_start_index = 0 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 = "

"//trim(instruction_name)//"

" one_link => html_link(trim(instruction_name)//".json", & "View Raw") res = trim(res)//nl//"

"//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//"

Launch Now

"//nl//"" end if res = trim(res)//nl//"

Jobs

" if(n_jobs == 0) then res = trim(res)//nl//"None Yet" else pager => generate_simple_pager(job_start_index, job_start_index + 4, 5, n_jobs, req%page,.false.) res = trim(res)//nl//job_link_text if(associated(pager)) then res = trim(res)//nl//pager deallocate(pager) end if deallocate(job_link_text) end if all_players => get_player_names() if(associated(all_players)) then res = trim(res)//nl//"

Assign

"//nl//"

Assign a player to these instructions

"//nl//"" deallocate(all_players) end if if(n_players > 0) then res = trim(res)//nl//"

Remove

"//nl//"

Remove a player from these instructions

"//nl//"" end if end function generate_one_instuction_html function generate_instructions_html(req) result(res) use captain_db use server_response, only:request implicit none type(request)::req character(len=:), pointer::res character(len=PLAYER_NAME_LENGTH), dimension(:), pointer::instruction_names integer::n, i, nsize character(len=:), pointer::one_player, scanlink n = get_instuctions_count() if(n == 0) then allocate(character(len=1024) :: res) res = "None Yet" else instruction_names => get_instruction_names() nsize = 1024 do i = 1, size(instruction_names) nsize = nsize + 16 + 2*len_trim(instruction_names(i)) end do allocate(character(len=nsize) :: res) res = "

Instructions

"//new_line(' ')//"" deallocate(instruction_names) end if res = trim(res)//new_line(' ')//"

Management

" scanlink => html_link(req%page//"?scan", "Scan for instructions now") res = trim(res)//new_line(' ')//"

"//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 = "

Existing Players

"//new_line(' ')//"" deallocate(players) end if res = trim(res)//new_line(' ')//"

Management

"// & new_line(' ')//'
'// & '
' end function generate_players_html function generate_one_job_html(req) result(res) use captain_db use server_response use special_filenames, only: get_task_result_static_filename use request_utils, only: get_status_utf8 implicit none type(request), intent(in)::req character(len=:), pointer::res character(4)::status integer::i, j, job_id type(job)::one_job character(PLAYER_NAME_LENGTH)::player character(1)::nl = new_line(' ') type(task), dimension(:), pointer::tasks character(32)::task_text, job_text character(len=:), pointer::task_results_filename, one_link, local_task_results_filename logical::file_exists res => null() ! Ugh, all this nonsense call req%last_component(job_text) j = index(job_text, ".", back=.true.) job_text(j:len(job_text)) = " " read(job_text, '(I8)') job_id one_job = get_job(job_id) if(one_job%id >= 0) then allocate(character(len=1024) :: res) status = get_status_utf8(one_job%status) res = "

Status - "//status//"

" call get_player_name(one_job%player, player) res = trim(res)//nl//nl//"

Running on "//trim(player)//nl// & "Last update at: "//one_job%time//"

" res = trim(res)//nl//nl//"

Task Results

" tasks => get_job_tasks(job_id) if(associated(tasks)) then res = trim(res)//nl//"" deallocate(tasks) else 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 = "

Listing for "//trim(public_path)//"

"//nl//"" end function generate_releases_html function generate_jobs_html(req) result(res) use captain_db use server_response use request_utils, only: render_jobs_links, generate_simple_pager use logging implicit none type(request)::req character(len=:), pointer::res type(job), dimension(:), pointer::jobs integer::n, nsize integer::i_start_jobs, ierr character(len=:), pointer::linklist, pager n = get_jobs_count() if(n == 0) then allocate(character(len=1024) :: res) res = "None Yet" else if(associated(req%query_string)) then read(req%query_string, *, iostat=ierr) i_start_jobs else ierr = -1 end if if(ierr /= 0) then i_start_jobs = 1 end if jobs => get_jobs() ! 15 per page nsize = 15*(2*PLAYER_NAME_LENGTH + 64) + 1024 allocate(character(len=nsize) :: res) res = " " linklist => render_jobs_links(jobs, i_start_jobs, min(i_start_jobs+14, n), .false.) res = trim(res)//new_line(' ')//trim(linklist) ! Pagers pager => generate_simple_pager(i_start_jobs, min(i_start_jobs+14, n), 15, n, req%page, .false.) if(associated(pager)) then res = trim(res)//new_line(' ')//pager deallocate(pager) end if 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