diff options
Diffstat (limited to 'player')
| -rw-r--r-- | player/config.f90 | 8 | ||||
| -rw-r--r-- | player/instructions.f90 | 198 | ||||
| -rw-r--r-- | player/levitating-player.prj | 96 | ||||
| -rw-r--r-- | player/main.f90 | 87 | ||||
| -rw-r--r-- | player/tasks.f90 | 216 | ||||
| -rw-r--r-- | player/utilities.F90 | 208 |
6 files changed, 813 insertions, 0 deletions
diff --git a/player/config.f90 b/player/config.f90 new file mode 100644 index 0000000..96c775c --- /dev/null +++ b/player/config.f90 @@ -0,0 +1,8 @@ +module config +implicit none + + character(len=:), pointer::working_directory + character(len=:), pointer::logfile + character(len=1024)::captain + character(len=36)::token +end module config diff --git a/player/instructions.f90 b/player/instructions.f90 new file mode 100644 index 0000000..8c671c4 --- /dev/null +++ b/player/instructions.f90 @@ -0,0 +1,198 @@ +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 + + 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_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 = 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 + + 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 + + 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, i, capture_filename) result(success) + use json_module + use tasks + use utilities + implicit none + + class(json_file)::j + integer, intent(in)::i + character(len=:), pointer, intent(out)::capture_filename + logical::success + + character(32)::operation + character(256)::url + character(256)::filename + + logical, dimension(4)::found + + call get_task_operation(j, i, operation) + + 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 + success = upload(url, filename) + 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, "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) == "shell") then + + + else if(trim(operation) == "delete_tree") then + + + end if + + end function perform_task + +end module instructions
\ No newline at end of file diff --git a/player/levitating-player.prj b/player/levitating-player.prj new file mode 100644 index 0000000..b6a36a4 --- /dev/null +++ b/player/levitating-player.prj @@ -0,0 +1,96 @@ +{ + "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 (target.exe)", + "Files":[{ + "filename":".\\config.f90", + "enabled":"1" + },{ + "filename":".\\instructions.f90", + "enabled":"1" + },{ + "filename":".\\main.f90", + "enabled":"1" + },{ + "filename":".\\tasks.f90", + "enabled":"1" + },{ + "filename":".\\utilities.F90", + "enabled":"1" + }] + }, + "Name":"levitating-player (target.exe)", + "Options":{ + "Compiler Options":{ + "Fortran Flags":"", + "Link Flags":"", + "C Flags":"" + }, + "Architecture":1, + "Type":0, + "Revision":2, + "Windows GUI":0, + "File Options":{ + "Library Directories":["Default Add-On Directory"], + "Build Directory":"build", + "Module Directory":"modules", + "Include Directories":["Default Add-On Include Directory"] + }, + "Target":"target.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":7, + "Link MPI Library":"false", + "Link LAPACK":0 + } + } +}
\ No newline at end of file diff --git a/player/main.f90 b/player/main.f90 new file mode 100644 index 0000000..cdf646e --- /dev/null +++ b/player/main.f90 @@ -0,0 +1,87 @@ +program player +use config +implicit none + + character(len=1024)::option + + integer::slen + integer::i + + 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) + + 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 + + ! Change directory to the working directory now + call chdir(working_directory) + + +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" + + end subroutine usage + +end program player
\ No newline at end of file diff --git a/player/tasks.f90 b/player/tasks.f90 new file mode 100644 index 0000000..c64cb40 --- /dev/null +++ b/player/tasks.f90 @@ -0,0 +1,216 @@ +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. + + 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(url, source_filename) + use config, only: token + use gemini_protocol, only: titan_post_url, STATUS_SUCCESS + implicit none + + logical::upload + character(*), intent(in)::url + character(*), intent(in)::source_filename + + character(len=:), allocatable::mod_url + + integer(kind=8)::file_size + integer::unit_number, istatus + + inquire(file=source_filename, size=file_size) + + open(newunit=unit_number, file=trim(source_filename), status='UNKNOWN', & + access='STREAM', form='UNFORMATTED', iostat=istatus) + + allocate(character(len=len_trim(url)) :: mod_url) + mod_url = url + + if(istatus == 0) then + istatus = titan_post_url(mod_url, unit_number, file_size, token) + upload = (istatus == STATUS_SUCCESS) + close(unit_number) + else + upload = .false. + end if + + deallocate(mod_url) + + end function upload + + function download(url, destination_filename) + use gemini_protocol, only: request_url, STATUS_SUCCESS + implicit none + + logical::download + character(*), intent(in)::url + character(*), intent(in)::destination_filename + + character(len=256)::mimetype + + character(len=:), allocatable::mod_url + + integer::unit_number, istatus + + allocate(character(len=len_trim(url)) :: mod_url) + mod_url = url + + open(newunit=unit_number, file=trim(destination_filename), status='UNKNOWN', & + access='STREAM', form='UNFORMATTED', iostat=istatus) + + 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) + if(res) then + res = shell("git submodule update", directory, capture_filename) + end if + 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) + end if + + deallocate(fulldir) + + end if + + end function delete_tree + +end module tasks diff --git a/player/utilities.F90 b/player/utilities.F90 new file mode 100644 index 0000000..c7fd523 --- /dev/null +++ b/player/utilities.F90 @@ -0,0 +1,208 @@ +module utilities + +#ifdef WINDOWS + character, parameter::dir_sep = '\' +#else + character, parameter::dir_sep = '/' +#endif + +contains + + function is_absolute_path(path) + implicit none + + logical::is_absolute_path + character(len=*), intent(in)::path + + is_absolute_path = .false. + if(path(1:1) == dir_sep) then + is_absolute_path = .true. + else +#ifdef WINDOWS + if(path(2:2) == ":") then + is_absolute_path = .true. + end if +#endif + end if + + end function is_absolute_path + + subroutine combine_paths(first, second, res) + implicit none + + character(len=*), intent(in)::first, second + character(len=*), intent(out)::res + + integer::i + + i = len_trim(first) + + if(first(i:i) == dir_sep) then + res = trim(first)//trim(second) + else + res = trim(first)//dir_sep//trim(second) + end if + + end subroutine combine_paths + + subroutine write_date_and_time(unit_number, values) + implicit none + + integer, intent(in)::unit_number + integer, intent(in), dimension(8)::values + + write(unit_number, '(I4, A1, I2, A1, I2, 1X, I2, A1, I2, A1, I2)') & + values(1), "-", & + values(2), "-", & + values(3), & + values(5), ":", & + values(6), ":", & + values(7) + + end subroutine write_date_and_time + + function remove_directory(absolute_dir, and_files) + implicit none + + character(*), intent(in)::absolute_dir + logical, intent(in), optional::and_files + logical::remove_directory + + character(len=8)::cmd, flags + integer::retval + +#ifdef WINDOWS + flags = " " + cmd = "rmdir" +#else + flags = "-r" + cmd = "rm" +#endif + + if(present(and_files)) then + if(and_files) then +#ifdef WINDOWS + flags = "/S /Q" +#else + flags = "-rf" +#endif + end if + end if + + call execute_command_line(trim(cmd)//" "//trim(flags)//" "//trim(absolute_dir), & + wait=.true., exitstat=retval) + + remove_directory = (retval == 0) + + end function remove_directory + + function read_into_buffer(unit_number, buffer) + implicit none + + integer, intent(in)::unit_number + character, dimension(*), intent(out)::buffer + integer::read_into_buffer + + integer::i, ierr + + ierr = 0 + i = 0 + do while(ierr == 0 .and. i < len(buffer)) + i = i + 1 + read(unit_number, iostat=ierr) buffer(i) + end do + + if(ierr /= 0) then + i = i - 1 + end if + + read_into_buffer = i + + end function read_into_buffer + + function generate_temporary_filename() result(fullpath) + use iso_c_binding + implicit none + + character(len=:), pointer::fullpath + type(c_ptr)::tmp_name + character(kind=c_char), dimension(:), pointer::cfullpath + integer(kind=c_size_t)::clength + integer::i + + interface + function c_strlen(p) bind(c, name='strlen') + use iso_c_binding + type(c_ptr), value::p + integer(kind=c_size_t)::strlen + end function c_strlen + + function c_malloc(x) bind(c, name='malloc') + use iso_c_binding + type(c_ptr)::c_malloc + integer(kind=c_size_t), value::x + end function c_malloc + + subroutine c_free(p) bind(c, name='free') + use iso_c_binding + type(c_ptr), value::p + end subroutine c_free + + end interface + +#ifdef WINDOWS + interface + function GetTempPath(n, b) bind(c, name='GetTempPathA') + use iso_c_binding + integer(kind=c_int32_t)::GetTempPath + integer(kind=c_int32_t), value::n + type(c_ptr), value::b + + function GetTempFileName(pn, prefix, unique, b) bind(c, name='GetTempFileNameA') + use iso_c_binding + integer(kind=c_int)::GetTempFileName + integer(kind=c_int), value::unique + type(c_ptr), value::pn, prefix, b + end function GetTempFileName + end interface + + type(c_ptr)::tmp_path + integer::res + + tmp_path = c_malloc(1024) + res = GetTempPath(1023, tmp_path) + + tmp_name = c_malloc(1024) + res = GetTempFileName(tmp_path, c_null_ptr(), 0, tmp_name) + + c_free(tmp_path) +#else + interface + function tmpnam(p) bind(c, name='tmpnam') + use iso_c_binding + type(c_ptr), value::p + type(c_ptr)::tmpnam + end function tmpnam + end interface + + type(c_ptr)::ignored + + tmp_name = c_malloc(int(1024, kind=c_size_t)) + + ignored = tmpnam(tmp_name) +#endif + + ! Convert the C Ptr to a Fortran object + clength = c_strlen(tmp_name) + call c_f_pointer(tmp_name, cfullpath, (/ clength /)) + allocate(character(len=clength)::fullpath) + do i = 1, clength + fullpath(i:i) = cfullpath(i) + end do + + cfullpath => null() + call c_free(tmp_name) + + end function generate_temporary_filename + +end module utilities
\ No newline at end of file |