Initial import

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