ssh docs and tests complete

R/ssh.R

@@ -11,7 +11,9 @@ For more information visit, https://github.com/antonellilab/outsider"
 #' @description Connect to a server, make accessible to \code{outsider} and
 #' set-up for \code{outsider} interaction.
 #' @return logical
-#' @family private-server
+#' @param session ssh session, see \code{\link[ssh]{ssh_connect}}
+#' @family public-server
+#' @example examples/server.R
 #' @export
 server_connect <- function(session) {
   if (!requireNamespace("ssh", quietly = TRUE)) {
@@ -21,7 +23,7 @@ server_connect <- function(session) {
   }
   # set in options()
   options('outsider-ssh-session' = session)
-  # create working dir
+  # create working dir (assumes a UNIX system)
   command <- c(paste0("if [ ! -e ", ssh_wd, " ];\nthen mkdir ", ssh_wd, "\nfi"),
                paste0("echo \"", readme_text, '\" > ', ssh_wd, '/README'))
   res <- ssh::ssh_exec_wait(session = session, command = command)
@@ -32,7 +34,8 @@ server_connect <- function(session) {
 #' @title Disconnect from a server
 #' @description Disconnect from a server and remove from \code{outsider}
 #' @return logical
-#' @family private-server
+#' @family public-server
+#' @example examples/server.R
 #' @export
 server_disconnect <- function() {
   if (is_server_connected()) {
@@ -105,7 +108,19 @@ server_download <- function(origin, dest) {
   ssh::scp_download(session = session, files = origin, to = tmp_flpth,
                     verbose = TRUE)
   fl <- file.path(tmp_flpth, list.files(tmp_flpth))
-  file.copy(from = fl, to = dest, recursive = TRUE)
+  if (length(fl) > 1) {
+    stop('More files than expected.')
+  }
+  if (dir.exists(fl)) {
+    if (!dir.exists(dest)) {
+      dir.create(dest)
+    }
+    for (subfl in list.files(fl)) {
+      file.copy(from = file.path(fl, subfl), to = file.path(dest, subfl))
+    }
+  } else {
+    file.copy(from = fl, to = dest)
+  }
   invisible(file.exists(dest))
 }
 

R/sys.R

@@ -1,3 +1,16 @@
+#' @name exec_wait
+#' @title Execute system commands and wait for response
+#' @description Passes arguments to \code{\link[sys]{exec_wait}}, if a server
+#' is connected arguments are passed to \code{\link[ssh]{ssh_exec_wait}}
+#' instead.
+#' @param cmd Command
+#' @param args Arguments
+#' @param std_out Standard out
+#' @param std_err Standard error
+#' @param std_in Standard in
+#' @param timeout Timeout
+#' @return logical
+#' @family private-sys
 exec_wait <- function(cmd, args = NULL, std_out = stdout(), std_err = stderr(), 
                       std_in = NULL, timeout = 0) {
   if (is_server_connected()) {
@@ -12,6 +25,18 @@ exec_wait <- function(cmd, args = NULL, std_out = stdout(), std_err = stderr(),
   res
 }
 
+#' @name exec_internal
+#' @title Execute system commands and wait for response
+#' @description Passes arguments to \code{\link[sys]{exec_internal}}, if a
+#' server is connected arguments are passed to
+#' \code{\link[ssh]{ssh_exec_internal}} instead.
+#' @param cmd Command
+#' @param args Arguments
+#' @param std_in Standard in
+#' @param error Call an error? T/F
+#' @param timeout Timeout
+#' @return logical
+#' @family private-sys
 exec_internal <- function(cmd, args = NULL, std_in = NULL, error = TRUE,
                           timeout = 0) {
   if (is_server_connected()) {
@@ -24,4 +49,4 @@ exec_internal <- function(cmd, args = NULL, std_in = NULL, error = TRUE,
                               error = error, timeout = timeout)
   }
   res
-}
+}

examples/server.R

@@ -0,0 +1,7 @@
+library(outsider.base)
+
+# NOT RUN
+# session <- ssh::ssh_connect(host = '[INSERT HOST IP]')
+# server_connect(session = session)
+# # run outsider.base commands, when finished
+# server_disconnect()

tests/testthat/test-ssh.R

@@ -0,0 +1,90 @@
+context('Testing \'ssh\'')
+session <- list('connected' = TRUE, 'user' = 'test_user',
+                'host' = 'test_host')
+test_that('server connection, fetch and disconnection functions work', {
+  # connected?
+  expect_false(outsider.base:::is_server_connected())
+  # connect
+  with_mock(
+    `ssh::ssh_exec_wait` = function(...) 0,
+    expect_true(server_connect(session = session))
+  )
+  # fetch
+  with_mock(
+    `ssh::ssh_info` = function(session) session,
+    expect_equal(outsider.base:::server_fetch(verbose = TRUE), session)
+  )
+  # disconnect
+  with_mock(
+    `ssh::ssh_info` = function(session) session,
+    `ssh::ssh_disconnect` = function(session) NULL,
+    expect_true(server_disconnect())
+  )
+  # is still connected?
+  expect_false(outsider.base:::is_server_connected())
+})
+context('Testing \'ssh\': copying files')
+test_that('server_upload() works', {
+  with_mock(
+    `outsider.base:::server_fetch` = function(verbose) session,
+    `ssh::scp_upload` = function(...) TRUE,
+    expect_true(outsider.base:::server_upload(fl = 'test_file'))
+  )
+})
+test_that('server_download() works', {
+  # file
+  with_mock(
+    `outsider.base:::server_fetch` = function(verbose) session,
+    `ssh::scp_download` = function(session, files, to, verbose) {
+      print(files)
+      print(to)
+      file.create(file.path(to, 'downloaded_file'))
+    },
+    outsider.base:::server_download(origin = 'test_file', dest = 'test_file')
+  )
+  expect_true(file.exists('test_file'))
+  file.remove('test_file')
+  # folder
+  with_mock(
+    `outsider.base:::server_fetch` = function(verbose) session,
+    `ssh::scp_download` = function(session, files, to, verbose) {
+      print(files)
+      print(to)
+      dir.create(file.path(to, 'downloaded_folder'))
+      file.create(file.path(to, 'downloaded_folder', 'test_file_1'))
+      file.create(file.path(to, 'downloaded_folder', 'test_file_2'))
+    },
+    outsider.base:::server_download(origin = 'test_folder',
+                                    dest = 'test_folder')
+  )
+  expect_true(dir.exists('test_folder'))
+  expect_true(file.exists(file.path('test_folder', 'test_file_1')))
+  unlink(x = 'test_folder', recursive = TRUE, force = TRUE)
+})
+test_that('upload/download/docker_cp work', {
+  print_docker_cmd <- function(args, ...) {
+    print(args)
+    TRUE
+  }
+  # up
+  with_mock(
+    `outsider.base:::docker_cmd` = print_docker_cmd,
+    `outsider.base:::is_server_connected` = function() TRUE,
+    `outsider.base:::server_upload` = function(fl) {
+      fl  == 'test_file'
+      },
+    expect_true(outsider.base:::docker_cp(origin = 'test_file',
+                                          dest = 'c1:test_file'))
+  )
+  # down
+  with_mock(
+    `outsider.base:::docker_cmd` = print_docker_cmd,
+    `outsider.base:::is_server_connected` = function() TRUE,
+    `outsider.base:::server_download` = function(origin, dest) {
+      origin == paste0(outsider.base:::ssh_wd, '/test_file') &
+        dest  == 'test_file'
+    },
+    expect_true(outsider.base:::docker_cp(origin = 'c1:test_file',
+                                          dest = 'test_file'))
+  )
+})

tests/testthat/test-sys.R

@@ -0,0 +1,27 @@
+context('Testing \'sys\'')
+test_that('exec_wait() works', {
+  with_mock(
+    `outsider.base:::is_server_connected` = function() FALSE,
+    `sys::exec_wait` = function(...) TRUE,
+    expect_true(outsider.base:::exec_wait(cmd = 'test'))
+  )
+  with_mock(
+    `outsider.base:::is_server_connected` = function() TRUE,
+    `outsider.base:::server_fetch` = function(verbose) 'session_obj',
+    `ssh::ssh_exec_wait` = function(...) TRUE,
+    expect_true(outsider.base:::exec_wait(cmd = 'test'))
+  )
+})
+test_that('exec_internal() works', {
+  with_mock(
+    `outsider.base:::is_server_connected` = function() FALSE,
+    `sys::exec_internal` = function(...) TRUE,
+    expect_true(outsider.base:::exec_internal(cmd = 'test'))
+  )
+  with_mock(
+    `outsider.base:::is_server_connected` = function() TRUE,
+    `outsider.base:::server_fetch` = function(verbose) 'session_obj',
+    `ssh::ssh_exec_internal` = function(...) TRUE,
+    expect_true(outsider.base:::exec_internal(cmd = 'test'))
+  )
+})