! Copyright (c) 2021 Approximatrix, LLC ! ! Permission is hereby granted, free of charge, to any person obtaining a copy ! of this software and associated documentation files (the "Software"), to deal ! in the Software without restriction, including without limitation the rights ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ! copies of the Software, and to permit persons to whom the Software is ! furnished to do so, subject to the following conditions: ! ! The above copyright notice and this permission notice shall be included in ! all copies or substantial portions of the Software. ! ! The Software shall be used for Good, not Evil. ! ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ! SOFTWARE. module instructions implicit none contains function parse_instructions(filename) result(j) use json_module implicit none type(json_file)::j character(*), intent(in)::filename call j%initialize() call j%load_file(filename=filename) end function parse_instructions subroutine destroy_instructions(j) use json_module implicit none type(json_file)::j call j%destroy() 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("status", json_string_value, found) if(found) then ! GNU Extension... :( Print *, fdate()//" Checkin status: "//json_string_value work_available = (json_string_value /= "idle") else work_available = .false. end if end function work_available subroutine get_instruction_name_from_checkin(j, name) use json_module implicit none class(json_file)::j character(*), intent(out)::name character(len=:), allocatable::json_string_value logical::found name = " " call j%get("instruction", json_string_value, found) if(found) then name = json_string_value end if end subroutine get_instruction_name_from_checkin function get_job_id_from_checkin(j) use json_module implicit none class(json_file)::j integer::get_job_id_from_checkin character(len=:), allocatable::json_string_value logical::found get_job_id_from_checkin = -1 call j%get("job", json_string_value, found) if(found) then read(json_string_value, *) get_job_id_from_checkin end if end function get_job_id_from_checkin subroutine get_description(j, description) use json_module implicit none class(json_file)::j character(*), intent(out)::description character(len=:), allocatable::json_string_value logical::found call j%get("description", json_string_value, found) if(.not. found .or. .not. allocated(json_string_value)) then description = "(instructions)" else description = json_string_value end if 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 class(json_file)::j integer::n type(json_value), pointer ::server logical::found character(3)::index_string n = 0 found = .true. do while(found) n = n + 1 write(index_string, '(I3)') n call j%get("tasks("//trim(index_string)//")", server, found) end do n = n - 1 end function get_task_count pure subroutine task_component(i, component, label) implicit none integer, intent(in)::i character(*), intent(in)::component character(*), intent(out)::label write(label, '(A6,I3,A2)') "tasks(", i, ")." label = trim(label)//trim(component) end subroutine task_component function get_task_string(j, i, component, res) result(found) use json_module implicit none class(json_file)::j integer, intent(in)::i character(*), intent(in)::component character(*), intent(out)::res logical::found character(len=64)::label character(len=:), allocatable::json_string_value call task_component(i, component, label) call j%get(trim(label), json_string_value, found) if(allocated(json_string_value)) then res = json_string_value end if end function get_task_string function get_task_logical(j, i, component, res) result(found) use json_module implicit none class(json_file)::j integer, intent(in)::i character(*), intent(in)::component logical, intent(out)::res logical::found character(len=64)::label character(len=:), allocatable::json_string_value call task_component(i, component, label) call j%get(trim(label), res, found) end function get_task_logical subroutine get_task_name(j, i, description) use json_module implicit none class(json_file)::j character(*), intent(out)::description integer, intent(in)::i logical::found found = get_task_string(j, i, "name", description) if(.not. found) then write(description, '(A4, 1X, I3)') "Task", i end if end subroutine get_task_name function get_task_failure_okay(j, i) result(res) use json_module, only: json_file implicit none class(json_file)::j integer, intent(in)::i logical::res if(.not. get_task_logical(j, i, "failure_okay", res)) then res = .false. end if end function get_task_failure_okay subroutine get_task_operation(j, i, op) use json_module implicit none class(json_file)::j character(*), intent(out)::op integer, intent(in)::i logical::found found = get_task_string(j, i, "operation", op) if(.not. found) then op = " " end if end subroutine get_task_operation function perform_task(j, job_id, i, capture_filename) result(success) use json_module use tasks use utilities implicit none class(json_file)::j integer, intent(in)::job_id, i character(len=:), pointer, intent(out)::capture_filename logical::success character(32)::operation character(256)::url character(256)::filename character(256)::branch character(256)::cmd logical::destructive logical, dimension(4)::found call get_task_operation(j, i, operation) Write(*, '(1X, A5, 1X, I3, 2X)', advance='no') "Task:", i Print *, "Operation: "//trim(operation) if(len_trim(operation) == 0) then success = .false. capture_filename => null() return end if found = .true. capture_filename => null() if(trim(operation) == "upload") then found(1) = get_task_string(j, i, "url", url) found(2) = get_task_string(j, i, "filename", filename) if(.not. all(found,1)) then success = .false. else if(index(filename, "*") > 0 .or. index(filename, "?") > 0) then success = upload_glob(url, filename, job_id) else success = upload(url, filename, job_id) end if end if else if(trim(operation) == "download") then found(1) = get_task_string(j, i, "url", url) found(2) = get_task_string(j, i, "filename", filename) if(.not. all(found,1)) then success = .false. else success = download(url, filename) end if else if(trim(operation) == "git_update") then capture_filename => generate_temporary_filename() found(1) = get_task_string(j, i, "origin", url) found(2) = get_task_string(j, i, "branch", branch) if(.not. found(2)) then branch = "master" found(2) = .true. end if found(3) = get_task_string(j, i, "directory", filename) ! If no directory is specified, do it in the current directory if(.not. found(3)) then filename = '.' found(3) = .true. end if found(4) = get_task_logical(j, i, "destructive", destructive) if(.not. found(4)) then destructive = .false. found(4) = .true. end if if(.not. all(found,1)) then success = .false. else success = git_update(url, branch, filename, destructive, capture_filename) end if else if(trim(operation) == "shell") then capture_filename => generate_temporary_filename() found(1) = get_task_string(j, i, "command", cmd) found(2) = get_task_string(j, i, "directory", filename) ! If no directory is specified, do it in the current directory if(.not. found(2)) then filename = '.' found(2) = .true. end if if(.not. all(found,1)) then success = .false. else success = shell(cmd, filename, capture_filename) end if else if(trim(operation) == "delete_tree") then found(1) = get_task_string(j, i, "directory", filename) if(.not. all(found,1)) then success = .false. else success = delete_tree(filename) end if end if if(get_task_failure_okay(j, i) .and. .not. success) then Print *, "Reseting to failure" success = .true. else if(.not. success) then Print *, "Task failure" end if end function perform_task subroutine perform_tasks(j, job_id) use json_module use talking use player_endpoints use utilities, only: delete_file implicit none class(json_file)::j integer, intent(in)::job_id integer::task_count integer::i integer::server_status logical::res character(len=:), pointer::captured_filename character(len=1024)::url character(len=40)::operation task_count = get_task_count(j) Print *, "Task count: ", task_count ! Remember to zero-index your json! do i = 1, task_count call get_task_operation(j, i, operation) call get_status_url(job_id, i, url, status=STATUS_STARTING, task_type=operation) Print *, "Reporting: "//trim(url) server_status = request_to_ignored(url) res = perform_task(j, job_id, 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) call get_status_url(job_id, i, url, posting=.true.) server_status = send_file(url, captured_filename) 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) Print *, "Attempted reporting failure" 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