! 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 tasks implicit none contains function shell(command, directory, capture_filename) use config use utilities implicit none logical::shell character(*), intent(in)::command character(*), intent(in)::directory character(*), intent(in)::capture_filename character(len=:), allocatable::task_directory integer::return_value, details_unit integer, dimension(8)::timedate_start, timedate_end shell = .false. Print *, "Command: "//trim(command) if(is_absolute_path(directory)) then call chdir(directory) else allocate(character(len=(len_trim(directory) + len_trim(working_directory) + 1)) :: task_directory) call combine_paths(working_directory, directory, task_directory) call chdir(task_directory) end if call date_and_time(values=timedate_start) call execute_command_line(trim(command)//" 1>> "//trim(capture_filename)//" 2>&1", & wait=.true., exitstat=return_value) shell = (return_value == 0) ! Write out some final info open(newunit=details_unit, file=capture_filename, status="old", access="append") write(details_unit, *) repeat("=", 80) write(details_unit, '(1X, A25, I3)') "Task Completed with Code ", return_value call date_and_time(values=timedate_end) write(details_unit, '(1X, A8, 1X)', advance='no') "Started:" call write_date_and_time(details_unit, timedate_start) write(details_unit, '(1X, A8, 1X)', advance='no') " Ended:" call write_date_and_time(details_unit, timedate_end) write(details_unit, *) "Command:" write(details_unit, *) " "//trim(command) write(details_unit, *) "Working Directory:" if(allocated(task_directory)) then write(details_unit, *) " "//trim(task_directory) else write(details_unit, *) " "//trim(directory) end if write(details_unit, *) repeat("=", 80) close(details_unit) call chdir(working_directory) if(allocated(task_directory)) then deallocate(task_directory) end if end function shell function upload_glob(url, mask, job_id) result(res) use utilities implicit none logical::res character(*), intent(in)::url character(*), intent(in)::mask integer, intent(in)::job_id character(DIR_LIST_STRING_LENGTH), dimension(:), pointer::files logical, dimension(:), allocatable::statuses integer::i character(len=:), allocatable::dir, fullname ! We can cheat by using the get_files_in_directory function since it ! is merely calling ls/dir, which will resolve the glob files => get_files_in_directory(mask) !allocate(files(2)) !files(1) = "/tmp/example/jagcdenc2.zip" !files(2) = "/tmp/example/jagenc2.zip" if(associated(files)) then allocate(character(len=len_trim(mask)) :: dir) allocate(character(len=len_trim(mask)+DIR_LIST_STRING_LENGTH+1) :: fullname) call path_from_file(mask, dir) allocate(statuses(size(files))) do i = 1, size(files) ! On some systems, we're getting subdirectories back... if(index(files(i), '/') + index(files(i), '\') > 0) then fullname = files(i) else call combine_paths(dir, files(i), fullname) end if statuses(i) = upload(url, fullname, job_id) end do res = all(statuses) deallocate(statuses) deallocate(files) deallocate(dir) deallocate(fullname) else res = .false. end if if(.not. res) then Print *, "Glob failure" end if end function upload_glob function upload(url, source_filename, job_id) result(res) use config, only: token, captain, identity use gemini_protocol, only: titan_post_url, STATUS_SUCCESS, STATUS_TEMPFAIL implicit none logical::res character(*), intent(in)::url character(*), intent(in)::source_filename integer, intent(in), optional::job_id character(len=:), allocatable::mod_url character(len=32)::job_id_keyval integer(kind=8)::file_size integer::unit_number, istatus, url_length, i logical::file_exists ! If we're here, we have a single filename to upload inquire(file=source_filename, size=file_size, exist=file_exists) if((.not. file_exists) .or. (file_size == 0)) then Print *, "File does not exist or size is 0: "//trim(source_filename), file_size res = .false. return end if Print *, "Opening for upload: "//trim(source_filename) open(newunit=unit_number, file=trim(source_filename), status='UNKNOWN', & access='STREAM', form='UNFORMATTED', iostat=istatus) if(index(url, "://") > 0) then ! Leave room for a possble filename url_length = len_trim(url) + len_trim(source_filename) allocate(character(len=url_length) :: mod_url) mod_url = url else ! Leave room for a possble filename url_length = len_trim(url) + len_trim(source_filename) + len_trim(captain) + 16 allocate(character(len=url_length) :: mod_url) mod_url = "titan://"//trim(captain) if(url(1:1) == "/") then mod_url = trim(mod_url)//trim(url) else mod_url = trim(mod_url)//"/"//trim(url) end if end if ! If the URL ends in a slash, it's a folder, add the filename base. if(mod_url(len_trim(mod_url):len_trim(mod_url)) == "/") then i = max(index(source_filename, "/", back=.true.), index(source_filename, "\", back=.true.)) if(i > 0) then mod_url = trim(mod_url)//source_filename(i+1:len_trim(source_filename)) else mod_url = trim(mod_url)//trim(source_filename) end if end if if(istatus == 0) then Print *, "Writing "//trim(mod_url) if(present(job_id)) then write(job_id_keyval, *) job_id job_id_keyval = "job="//trim(adjustl(job_id_keyval)) istatus = titan_post_url(mod_url, unit_number, file_size, trim(identity)//":"//trim(token), & extra=trim(job_id_keyval)) else istatus = titan_post_url(mod_url, unit_number, file_size, trim(identity)//":"//trim(token)) end if Print *, "Response code from server: ", istatus if(istatus == STATUS_TEMPFAIL) then Print *, "Server failed to finish handling file - temporary failure" end if res = (istatus == STATUS_SUCCESS) close(unit_number) else res = .false. end if deallocate(mod_url) if(.not. res) then Print *, "Upload Failure" end if end function upload function download(url, destination_filename) use gemini_protocol, only: request_url, STATUS_SUCCESS use config, only: captain implicit none logical::download character(*), intent(in)::url character(*), intent(in)::destination_filename character(len=256)::mimetype character(len=:), allocatable::mod_url integer::url_length integer::unit_number, istatus if(index(url, "://") > 0) then allocate(character(len=len_trim(url)) :: mod_url) mod_url = url else url_length = len_trim(url) + len_trim(captain) + 16 allocate(character(len=url_length) :: mod_url) mod_url = "gemini://"//trim(captain) if(url(1:1) == "/") then mod_url = trim(mod_url)//trim(url) else mod_url = trim(mod_url)//"/"//trim(url) end if end if open(newunit=unit_number, file=trim(destination_filename), status='UNKNOWN', & access='STREAM', iostat=istatus) ! , form='FORMATTED', if(istatus == 0) then istatus = request_url(mod_url, unit_number, mimetype) download = (istatus == STATUS_SUCCESS) close(unit_number) else download = .false. end if deallocate(mod_url) end function download function git_update(origin, branch, directory, destructive, capture_filename) use config implicit none logical::git_update character(*), intent(in)::origin character(*), intent(in)::directory character(*), intent(in)::branch logical, intent(in)::destructive character(*), intent(in)::capture_filename logical::res integer::retval character(len=32)::options ! If we're working in destructive mode, just checkout the current head if(destructive) then res = delete_tree(directory) options = " --depth 1" else options = " " end if call execute_command_line("mkdir "//trim(directory), wait=.true., exitstat=retval) ! If Zero, there is no existing directory... if(retval == 0) then res = shell("git clone"//trim(options)//" "//trim(origin)//" "//trim(directory), working_directory, capture_filename) if(res) then res = shell("git submodule init", directory, capture_filename) end if else res = .true. end if ! Check that nothing went wrong so far... if(res) then res = shell("git checkout "//trim(branch), directory, capture_filename) end if if(res) then res = shell("git pull", directory, capture_filename) end if if(res) then res = shell("git submodule update", directory, capture_filename) end if git_update = res end function git_update function delete_tree(directory) use config, only: working_directory use utilities implicit none logical::delete_tree character(*), intent(in)::directory character(len=:), allocatable::fulldir ! Only proceed in the working directory... ! Relative paths could still break this, but what can you do... if(is_absolute_path(directory)) then delete_tree = .false. else allocate(character(len=( len_trim(working_directory)+len_trim(directory)+1 )) :: fulldir) call combine_paths(working_directory, directory, fulldir) ! No spaces allowed. Tough... if(index(fulldir, " ") /= 0) then delete_tree = .false. else delete_tree = remove_directory(fulldir, and_files=.true.) end if deallocate(fulldir) end if end function delete_tree end module tasks