diff options
Diffstat (limited to 'player')
| -rw-r--r-- | player/endpoints.f90 | 150 | ||||
| -rw-r--r-- | player/instructions.f90 | 75 | ||||
| -rw-r--r-- | player/levitating-player-windows.prj | 102 | ||||
| -rw-r--r-- | player/levitating-player.prj | 60 | ||||
| -rw-r--r-- | player/main.F90 | 109 | ||||
| -rw-r--r-- | player/player.F90 | 193 | ||||
| -rw-r--r-- | player/talking.f90 | 115 | ||||
| -rw-r--r-- | player/utilities.F90 | 22 |
8 files changed, 666 insertions, 160 deletions
diff --git a/player/endpoints.f90 b/player/endpoints.f90 new file mode 100644 index 0000000..1a8ca73 --- /dev/null +++ b/player/endpoints.f90 @@ -0,0 +1,150 @@ +module player_endpoints +implicit none + + character(*), parameter::LOCATION_CHECK_IN = "/player/{name}/checkin.json" + character(*), parameter::LOCATION_STATUS = "/player/{name}/job/{jobid}/task/{step}" + character(*), parameter::LOCATION_JOB_COMPLETE = "/player/{name}/job/{jobid}/complete" + character(*), parameter::LOCATION_JOB_FAILED = "/player/{name}/job/{jobid}/failed" + + integer, parameter::STATUS_STARTING=1 + integer, parameter::STATUS_COMPLETED=2 + integer, parameter::STATUS_FAILED=3 + integer, parameter::STATUS_IN_PROGRESS=4 + + character(len=10), dimension(4)::status_text = (/ "starting ", & + "complete ", & + "failed ", & + "inprogress" /) + + interface replace_field + module procedure replace_field_text + module procedure replace_field_int + end interface + +contains + + subroutine base_url(server, location, post, res) + implicit none + + character(*), intent(in)::server + character(*), intent(in)::location + logical, intent(in)::post + character(*), intent(out)::res + + if(post) then + res = "titan://"//trim(server)//trim(location) + else + res = "gemini://"//trim(server)//trim(location) + end if + + end subroutine base_url + + subroutine replace_field_text(str, field, val) + implicit none + + character(*), intent(inout)::str + character(*), intent(in)::field + character(*), intent(in)::val + + character(len=:), allocatable::holding + integer::length_estimate + integer::field_location, i, j + + ! This is too big, but close enough + length_estimate = len_trim(str) + len_trim(val) + allocate(character(len=length_estimate) :: holding) + holding = " " + + ! Find the field + field_location = index(str, "{"//trim(field)//"}") + if(field_location > 0) then + + holding(1:field_location-1) = str(1:field_location-1) + + j = field_location + holding(j:j+len_trim(val)) = trim(val) + + i = field_location + len_trim(field) + 2 + j = len_trim(holding)+1 + holding(j:j+(len_trim(str)-i)) = str(i:len_trim(str)) + + ! Put the results back now + str = holding + + end if + + deallocate(holding) + + end subroutine replace_field_text + + subroutine replace_field_int(str, field, val) + implicit none + + character(*), intent(inout)::str + character(*), intent(in)::field + integer, intent(in)::val + + character(16)::int_text + + write(int_text, *) val + + call replace_field_text(str, field, trim(adjustl(int_text))) + + end subroutine replace_field_int + + subroutine get_check_in_url(res) + use config + implicit none + + character(*), intent(out)::res + + call base_url(captain, LOCATION_CHECK_IN, .false., res) + call replace_field(res, "name", identity) + + end subroutine get_check_in_url + + subroutine get_status_url(job, step, url, posting, status) + use config + implicit none + + integer, intent(in)::job + integer, intent(in)::step + logical, intent(in), optional::posting + integer, intent(in), optional::status + character(*), intent(out)::url + + character(32)::int_text + + if(present(posting)) then + call base_url(captain, LOCATION_STATUS, posting, url) + else + call base_url(captain, LOCATION_STATUS, .false., url) + end if + call replace_field(url, "name", identity) + call replace_field(url, "jobid", job) + call replace_field(url, "step", step) + + if(present(status)) then + url = trim(url)//"?"//trim(status_text(status)) + end if + + end subroutine get_status_url + + subroutine get_job_report_url(job, success, res) + use config + implicit none + + integer, intent(in)::job + logical, intent(in)::success + character(*), intent(out)::res + + if(success) then + call base_url(captain, LOCATION_JOB_COMPLETE, .false., res) + else + call base_url(captain, LOCATION_JOB_FAILED, .false., res) + end if + call replace_field(res, "jobid", job) + + end subroutine get_job_report_url + +end module player_endpoints diff --git a/player/instructions.f90 b/player/instructions.f90 index ce28413..fed43c4 100644 --- a/player/instructions.f90 +++ b/player/instructions.f90 @@ -24,6 +24,22 @@ contains end subroutine destroy_instructions + function work_available(j) + use json_module + implicit none + + class(json_file)::j + logical::work_available + + character(len=:), allocatable::json_string_value + logical::found + + call j%get("idle", json_string_value, found) + + work_available = .not. found + + end function work_available + subroutine get_description(j, description) use json_module implicit none @@ -42,6 +58,22 @@ contains end subroutine get_description + function get_job_id(j) result(id) + use json_module + implicit none + + class(json_file)::j + integer::id + + logical::found + + call j%get("id", id, found) + if(.not. found) then + id = -1 + end if + + end function get_job_id + function get_task_count(j) result(n) use json_module implicit none @@ -167,6 +199,7 @@ contains character(256)::url character(256)::filename character(256)::branch + character(256)::cmd logical::destructive logical, dimension(4)::found @@ -216,13 +249,13 @@ contains else if(trim(operation) == "shell") then capture_filename => generate_temporary_filename() - found(1) = get_task_string(j, i, "command", url) + found(1) = get_task_string(j, i, "command", cmd) found(2) = get_task_string(j, i, "directory", filename) if(.not. all(found,1)) then success = .false. else - success = shell(command, directory, capture_filename) + success = shell(cmd, filename, capture_filename) end if else if(trim(operation) == "delete_tree") then @@ -231,7 +264,7 @@ contains if(.not. all(found,1)) then success = .false. else - success = delete_tree(command, directory, capture_filename) + success = delete_tree(filename) end if end if @@ -240,38 +273,64 @@ contains subroutine perform_tasks(j) use json_module + use talking + use player_endpoints + use utilities, only: delete_file implicit none class(json_file)::j + integer::task_count integer::i + integer::server_status logical::res - + integer::job_id character(len=:), pointer::captured_filename + character(len=1024)::url task_count = get_task_count(j) + job_id = get_job_id(j) do i = 1, task_count + call get_status_url(job_id, i, url, status=STATUS_STARTING) + server_status = request_to_ignored(url) + res = perform_task(j, i, captured_filename) if(associated(captured_filename)) then if(res) then - + call get_status_url(job_id, i, url, status=STATUS_COMPLETED) + server_status = request_to_ignored(url) + + call get_status_url(job_id, i, url, posting=.true.) + server_status = send_file(url, captured_filename) + + ! Get rid of the local file + call delete_file(captured_filename) + deallocate(captured_filename) + captured_filename => null() else - + call get_status_url(job_id, i, url, status=STATUS_FAILED) + server_status = request_to_ignored(url) exit endif + else if(res) then - + call get_status_url(job_id, i, url, status=STATUS_COMPLETED) + server_status = request_to_ignored(url) else - + call get_status_url(job_id, i, url, status=STATUS_FAILED) + server_status = request_to_ignored(url) exit endif end if end do + call get_job_report_url(job_id, res, url) + server_status = request_to_ignored(url) + end subroutine perform_tasks end module instructions
\ No newline at end of file diff --git a/player/levitating-player-windows.prj b/player/levitating-player-windows.prj new file mode 100644 index 0000000..0566b8a --- /dev/null +++ b/player/levitating-player-windows.prj @@ -0,0 +1,102 @@ +{ + "Root":{ + "Folders":[{ + "Folders":[], + "Name":"+common", + "Files":[{ + "filename":"..\\common\\jessl.f90", + "enabled":"1" + },{ + "filename":"..\\common\\network.F90", + "enabled":"1" + },{ + "filename":"..\\common\\protocol.f90", + "enabled":"1" + },{ + "filename":"..\\common\\request.f90", + "enabled":"1" + },{ + "filename":"..\\common\\wsa.f90", + "enabled":"1" + }] + }], + "Name":"+levitating-player-windows (levitating-player.exe)", + "Files":[{ + "filename":".\\config.f90", + "enabled":"1" + },{ + "filename":".\\endpoints.f90", + "enabled":"1" + },{ + "filename":".\\instructions.f90", + "enabled":"1" + },{ + "filename":".\\player.F90", + "enabled":"1" + },{ + "filename":".\\talking.f90", + "enabled":"1" + },{ + "filename":".\\tasks.f90", + "enabled":"1" + },{ + "filename":".\\utilities.F90", + "enabled":"1" + }] + }, + "Name":"levitating-player-windows (levitating-player.exe)", + "Options":{ + "Compiler Options":{ + "Fortran Flags":"-DGNU -DWINDOWS", + "Link Flags":"-lssl -lcrypto -lws2_32 -lcrypt32 -ljsonfortran", + "C Flags":"" + }, + "Architecture":1, + "Type":0, + "Revision":2, + "Windows GUI":0, + "File Options":{ + "Library Directories":["Default Add-On Directory","../support/openssl-1.1.1f-win64-mingw/lib"], + "Build Directory":"build", + "Module Directory":"modules", + "Include Directories":["Default Add-On Include Directory"] + }, + "Target":"levitating-player.exe", + "Fortran Options":{ + "Use C Preprocessor":"false", + "Runtime Diagnostics":"false", + "Floating Point Exception Trap":0, + "Cray Pointers":"false", + "Enable Coarrays":"false", + "Enable OpenMP":"false", + "Initialize Variables to Zero":"false", + "Default Double for Real":"false" + }, + "Code Generation Options":{ + "CPU Specific":"false", + "Processor":"generic", + "Aggressive Loops":"false", + "Debugging":"true", + "Optimization Mode":0, + "Profiling":"false" + }, + "Build Dependencies":1, + "Launch Options":{ + "Working Directory":"", + "Launch Using MPI":"false", + "Keep Console":"true", + "External Console":"false", + "Command Line Arguments":"", + "Build Before Launch":"true" + }, + "Build Options":{ + "Makefile":"Makefile", + "Auto Makefile":"true" + }, + "Linker Options":{ + "Static Linking Mode":3, + "Link MPI Library":"false", + "Link LAPACK":0 + } + } +}
\ No newline at end of file diff --git a/player/levitating-player.prj b/player/levitating-player.prj index 4e4cedc..aaed51c 100644 --- a/player/levitating-player.prj +++ b/player/levitating-player.prj @@ -1,71 +1,53 @@ { - "Layout":{ - "Panels":[{ - "Side 1":{ - "Type":"Panel", - "Id":1 - }, - "Position":49, - "Id":1, - "Direction":"Horizontal", - "Side 2":{ - "Type":"Panel", - "Id":2 - } - }], - "Root":1 - }, "Root":{ "Folders":[{ "Folders":[], "Name":"+common", "Files":[{ - "filename":"../common/jessl.f90", + "filename":"..\\common\\jessl.f90", "enabled":"1" },{ - "filename":"../common/network.F90", + "filename":"..\\common\\network.F90", "enabled":"1" },{ - "filename":"../common/protocol.f90", + "filename":"..\\common\\protocol.f90", "enabled":"1" },{ - "filename":"../common/request.f90", + "filename":"..\\common\\request.f90", "enabled":"1" },{ - "filename":"../common/wsa.f90", + "filename":"..\\common\\wsa.f90", "enabled":"1" }] }], "Name":"+levitating-player (target.exe)", "Files":[{ - "filename":"config.f90", - "enabled":"1", - "panel":1, - "open":"1" + "filename":".\\config.f90", + "enabled":"1" + },{ + "filename":".\\endpoints.f90", + "enabled":"1" },{ - "filename":"instructions.f90", - "enabled":"1", - "panel":1, - "open":"1" + "filename":".\\instructions.f90", + "enabled":"1" },{ - "filename":"main.F90", - "enabled":"1", - "panel":1, - "open":"1" + "filename":".\\player.F90", + "enabled":"1" },{ - "filename":"tasks.f90", - "enabled":"1", - "panel":2, - "open":"1" + "filename":".\\talking.f90", + "enabled":"1" + },{ + "filename":".\\tasks.f90", + "enabled":"1" },{ - "filename":"utilities.F90", + "filename":".\\utilities.F90", "enabled":"1" }] }, "Name":"levitating-player (target.exe)", "Options":{ "Compiler Options":{ - "Fortran Flags":"", + "Fortran Flags":"-DGNU", "Link Flags":"", "C Flags":"" }, diff --git a/player/main.F90 b/player/main.F90 deleted file mode 100644 index 127a8f7..0000000 --- a/player/main.F90 +++ /dev/null @@ -1,109 +0,0 @@ -program player -use config -implicit none - - character(len=1024)::option - - integer::slen - integer::i - - identity = " " - - i = 1 - do while(i <= command_argument_count()) - call get_command_argument(i, option) - - if(option(1:1) /= "-") then - captain = option - - else if(trim(option) == "-h") then - call usage() - stop - - else if(trim(option) == "-w") then - i = i + 1 - call get_command_argument(i, length=slen) - allocate(character(len=slen) :: working_directory) - call get_command_argument(i, working_directory) - - else if(trim(option) == "-l") then - i = i + 1 - call get_command_argument(i, length=slen) - allocate(character(len=slen) :: logfile) - call get_command_argument(i, logfile) - - else if(trim(option) == "-i") then - i = i + 1 - call get_command_argument(i, identity) - - end if - - i = i + 1 - end do - - ! Assign working directory from command if not specified - if(.not. associated(working_directory)) then - call get_command_argument(0, length=slen) - allocate(character(len=slen) :: working_directory) - call get_command_argument(i, working_directory) - i = index(working_directory, "/", back=.true.) - if(i == 0) then - i = index(working_directory, "/", back=.true.) - endif - if(i == 0) then - Print *, "Could not determine working_directory" - stop - else - working_directory(i:slen) = ' ' - end if - end if - - ! Assign a temporary directory and file for a log file - ! NOTE: will fail on Windows - if(.not. associated(logfile)) then - allocate(character(len=256) :: logfile) - logfile = "/tmp/levitating.log" - end if - - ! Assign this computer an identity if not explicitly specified - if(len_trim(identity) == 0) then -#ifdef GNU - call hostnm(identity) -#else - Print *, "Could not determine host identity" - stop -#endif - end if - - ! Change directory to the working directory now - call chdir(working_directory) - - do while(.true.) - - - - end do - -contains - - subroutine usage() - implicit none - - character(len=256)::pname - - call get_command_argument(0, pname) - - Print *, "Usage: "//trim(pname)//" <options> <captain>" - Print *, " " - Print *, "captain is the build control server" - Print *, " " - - Print *, "Options:" - Print *, " -h Display this help" - Print *, " -w <dir> Use dir as the working directory" - Print *, " -l <log> Use log as the logfile" - Print *, " -i <identity> This players identity" - - end subroutine usage - -end program player
\ No newline at end of file diff --git a/player/player.F90 b/player/player.F90 new file mode 100644 index 0000000..0eb5a72 --- /dev/null +++ b/player/player.F90 @@ -0,0 +1,193 @@ +program player +use config +use instructions +use player_endpoints +use json_module +use talking + +#ifdef WINDOWS +use wsa_network, only: windows_network_startup => startup +#endif + +implicit none + + character(len=1024)::url + type(json_file)::j + logical::work_to_do, json_available + + integer::i_task + +#ifdef WINDOWS + call windows_network_startup() +#endif + + call parse_options() + + ! Change directory to the working directory now + call chdir(working_directory) + + do while(.true.) + + ! Check in for work + call get_check_in_url(url) + json_available = request_json(url, j) + if(json_available) then + work_to_do = work_available(j) + end if + + if(work_to_do) then + + ! Task loop + call perform_tasks(j) + + else + +#ifdef GNU + call sleep(50) +#endif + + end if + + ! Sleep a bit regardless +#ifdef GNU + call sleep(10) +#endif + + ! Destroy any existing json + if(json_available) then + call destroy_instructions(j) + end if + + end do + +contains + + subroutine usage() + implicit none + + character(len=256)::pname + + call get_command_argument(0, pname) + + Print *, "Usage: "//trim(pname)//" <options> <captain>" + Print *, " " + Print *, "captain is the build control server" + Print *, " " + + Print *, "Options:" + Print *, " -h Display this help" + Print *, " -w <dir> Use dir as the working directory" + Print *, " -l <log> Use log as the logfile" + Print *, " -i <identity> This players identity" + + end subroutine usage + + subroutine parse_options + use config + implicit none + + character(len=1024)::option + integer::slen + integer::i + + identity = " " + + i = 1 + do while(i <= command_argument_count()) + call get_command_argument(i, option) + + if(option(1:1) /= "-") then + captain = option + + else if(trim(option) == "-h") then + call usage() + stop + + else if(trim(option) == "-w") then + i = i + 1 + call get_command_argument(i, length=slen) + allocate(character(len=slen) :: working_directory) + call get_command_argument(i, working_directory) + + else if(trim(option) == "-l") then + i = i + 1 + call get_command_argument(i, length=slen) + allocate(character(len=slen) :: logfile) + call get_command_argument(i, logfile) + + else if(trim(option) == "-i") then + i = i + 1 + call get_command_argument(i, identity) + + end if + + i = i + 1 + end do + + ! Assign working directory from command if not specified + if(.not. associated(working_directory)) then + call get_command_argument(0, length=slen) + allocate(character(len=slen) :: working_directory) + call get_command_argument(i, working_directory) + i = index(working_directory, "/", back=.true.) + if(i == 0) then + i = index(working_directory, "/", back=.true.) + endif + if(i == 0) then + Print *, "Could not determine working_directory" + stop + else + working_directory(i:slen) = ' ' + end if + end if + + ! Assign a temporary directory and file for a log file + ! NOTE: will fail on Windows + if(.not. associated(logfile)) then + allocate(character(len=256) :: logfile) + logfile = "/tmp/levitating.log" + end if + + ! Assign this computer an identity if not explicitly specified + if(len_trim(identity) == 0) then +#ifdef GNU + call hostnm(identity) +#else + Print *, "Could not determine host identity" + stop +#endif + end if + + end subroutine parse_options + + function request_json(url, j) + use json_module + use gemini_protocol + use instructions, only: parse_instructions + use talking, only: request_to_temporary_file + use utilities, only: delete_file + implicit none + + logical::request_json + character(*), intent(in)::url + type(json_file), intent(out)::j + + character(:), pointer::filename + integer::status_code + + status_code = request_to_temporary_file(url, filename) + if(status_code == STATUS_SUCCESS) then + j = parse_instructions(filename) + call delete_file(filename) + else + request_json = .false. + end if + + if(associated(filename)) then + call delete_file(filename) + deallocate(filename) + end if + + end function request_json + +end program player
\ No newline at end of file diff --git a/player/talking.f90 b/player/talking.f90 new file mode 100644 index 0000000..f41d3bb --- /dev/null +++ b/player/talking.f90 @@ -0,0 +1,115 @@ +module talking +implicit none + +contains + + function request_to_file(url, filename) result(status_code) + use utilities + use gemini_protocol + implicit none + + character(*), intent(in)::url + character(*), intent(in)::filename + + character(64)::return_type + + integer::unit_number + integer::status_code + integer::istatus + + character(len=:), allocatable::mod_url + + allocate(character(len=len_trim(url)) :: mod_url) + mod_url = url + + open(newunit=unit_number, file=filename, status='UNKNOWN', & + access='STREAM', form='UNFORMATTED', iostat=istatus) + + if(istatus == 0) then + status_code = request_url(mod_url, unit_number, return_type) + else + status_code = STATUS_LOCALFAIL + end if + + close(unit_number) + + deallocate(mod_url) + + end function request_to_file + + function request_to_temporary_file(url, filename) result(status_code) + use utilities, only: generate_temporary_filename + use gemini_protocol, only: STATUS_LOCALFAIL + implicit none + + character(*), intent(in)::url + character(:), pointer::filename + integer::status_code + + filename = generate_temporary_filename() + if(.not. associated(filename)) then + status_code = STATUS_LOCALFAIL + else + status_code = request_to_file(url, filename) + end if + + end function request_to_temporary_file + + function request_to_ignored(url) result(status_code) + use gemini_protocol + implicit none + + character(*), intent(in)::url + integer::status_code + integer::io + character(64)::return_type + + character(len=:), allocatable::mod_url + + allocate(character(len=len_trim(url)) :: mod_url) + mod_url = url + + open(newunit=io, form="formatted", status="scratch", access='stream') + status_code = request_url(mod_url, io, return_type) + close(io) + + deallocate(mod_url) + + end function request_to_ignored + + function send_file(url, filename) result(status_code) + use gemini_protocol + use config, only: token + implicit none + + character(*), intent(in)::url + character(*), intent(in)::filename + integer::status_code + integer::io + + character(64)::return_type + character(len=:), allocatable::mod_url + + integer(kind=8)::file_size + integer::unit_number, istatus + + allocate(character(len=len_trim(url)) :: mod_url) + mod_url = url + + inquire(file=filename, size=file_size) + + open(newunit=unit_number, file=trim(filename), status='UNKNOWN', & + access='STREAM', form='UNFORMATTED', iostat=istatus) + + if(istatus == 0) then + status_code = titan_post_url(mod_url, unit_number, file_size, token) + close(unit_number) + else + status_code = STATUS_LOCALFAIL + end if + + deallocate(mod_url) + + end function send_file + +end module talking
\ No newline at end of file diff --git a/player/utilities.F90 b/player/utilities.F90 index c7fd523..2e19031 100644 --- a/player/utilities.F90 +++ b/player/utilities.F90 @@ -157,6 +157,7 @@ contains integer(kind=c_int32_t)::GetTempPath integer(kind=c_int32_t), value::n type(c_ptr), value::b + end function GetTempPath function GetTempFileName(pn, prefix, unique, b) bind(c, name='GetTempFileNameA') use iso_c_binding @@ -169,13 +170,13 @@ contains type(c_ptr)::tmp_path integer::res - tmp_path = c_malloc(1024) + tmp_path = c_malloc(int(1024, kind=c_size_t)) res = GetTempPath(1023, tmp_path) - tmp_name = c_malloc(1024) - res = GetTempFileName(tmp_path, c_null_ptr(), 0, tmp_name) + tmp_name = c_malloc(int(1024, kind=c_size_t)) + res = GetTempFileName(tmp_path, c_null_ptr, 0, tmp_name) - c_free(tmp_path) + call c_free(tmp_path) #else interface function tmpnam(p) bind(c, name='tmpnam') @@ -205,4 +206,17 @@ contains end function generate_temporary_filename + subroutine delete_file(filename) + implicit none + + character(*), intent(in)::filename + +#ifdef GNU + call unlink(filename) +#else + ! Not implemented... +#endif + + end subroutine delete_file + end module utilities
\ No newline at end of file |