├── .Rbuildignore ├── .github └── workflows │ ├── R-CMD-check.yaml │ └── drat.yaml ├── .gitignore ├── .lintr ├── DESCRIPTION ├── Dockerfile ├── INWTRSync.Rproj ├── LICENSE ├── NAMESPACE ├── R ├── awscli.R ├── awss3.R ├── getData.R ├── getFile.R ├── listFiles.R ├── removeAllFiles.R ├── removeFile.R ├── rsync.R ├── rsynccli.R ├── sendAllFiles.R ├── sendFile.R ├── sendObject.R ├── syncAllFiles.R └── validateFile.R ├── README.Rmd ├── README.md ├── man ├── awss3.Rd ├── checkSystemResult.Rd ├── rsync.Rd └── rsynccli.Rd ├── scratch.R └── tests ├── daemon-startup.sh ├── shutdown-remote.sh ├── startup-remote.sh ├── test-remote.R ├── testthat.R └── testthat ├── helper-setupTestEnvironment.R ├── test-as.characet.R ├── test-awss3.R ├── test-checkForSystemResult.R ├── test-getData.R ├── test-getFile.R ├── test-listFiles.R ├── test-removeAllFiles.R ├── test-removeFile.R ├── test-sendAllFiles.R ├── test-sendFile.R ├── test-sendObject.R ├── test-syncAllFiles.R └── test-validateFile.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis\.yml$ 4 | ^scratch\.R$ 5 | ^Readme\.Rmd$ 6 | ^codecov\.yml$ 7 | ^Jenkinsfile$ 8 | ^Dockerfile$ 9 | ^\.aws$ 10 | ^\.github$ 11 | ^deploy\.sh$ 12 | ^\.prettierignore$ 13 | ^\.lintr$ 14 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | name: R-CMD-check 2 | 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | branches: [main] 8 | workflow_dispatch: # run workflow manually 9 | 10 | jobs: 11 | R-CMD-check: 12 | runs-on: ubuntu-latest 13 | steps: 14 | - name: Checkout 15 | uses: actions/checkout@v4 16 | 17 | - name: Build and test 18 | run: | 19 | docker build -t test-build . && docker run test-build 20 | -------------------------------------------------------------------------------- /.github/workflows/drat.yaml: -------------------------------------------------------------------------------- 1 | name: Deploy to drat 2 | 3 | on: 4 | workflow_run: 5 | workflows: ["R-CMD-check"] 6 | types: 7 | - completed 8 | branches: main 9 | workflow_dispatch: # run workflow manually 10 | 11 | 12 | jobs: 13 | drat: 14 | runs-on: ubuntu-latest 15 | if: ${{ github.event.workflow_run.conclusion == 'success' }} 16 | steps: 17 | - uses: mikemahoney218/upload-to-drat-repo@v0.3 18 | with: 19 | drat_repo: 'INWTlab/drat' 20 | token: "${{ secrets.GH_ACTION_DRAT }}" 21 | commit_message: "update ${{ github.event.repository.name }} on drat" 22 | commit_email: "brother-mfc@inwt-statistics.de" 23 | archive: true 24 | 25 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | ^\.travis\.yml$ 6 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: with_defaults( 2 | object_name_linter("camelCase"), 3 | line_length_linter(90) 4 | ) 5 | exclude: "# Exclude Linting" 6 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: rsync 2 | Type: Package 3 | Title: API to use rsync 4 | Version: 24.10.0 5 | Author: INWT Statistics GmbH 6 | Authors@R: c(person("Sebastian", "Warnholz", email = "sebastian.warnholz@inwt-statistics.de", role = c("aut", "cre")), 7 | person("Jonathan", "Bob", email = "jonathan.bob@inwt-statistics.de", role = c("aut")), 8 | person("David", "Berscheid", email = "david.berscheid@inwt-statistics.de", role = c("aut")), 9 | person("Ben", "Raymond", role = c("ctb"))) 10 | Description: The package provides an API to use rsync from R. It lets you easily 11 | synchronize and transfer files across computer systems or locations. 12 | SystemRequirements: rsync 13 | Depends: 14 | R (>= 3.4.0) 15 | Imports: 16 | dat, 17 | data.table, 18 | jsonlite, 19 | openssl, 20 | tools 21 | Suggests: 22 | testthat, 23 | covr 24 | License: MIT + file LICENSE 25 | Encoding: UTF-8 26 | LazyData: true 27 | RoxygenNote: 7.3.1 28 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM inwt/r-batch:latest 2 | 3 | ADD . . 4 | 5 | RUN apt-get -y update \ 6 | && apt-get install -y --no-install-recommends \ 7 | awscli git \ 8 | && apt-get autoremove -y \ 9 | && apt-get autoclean -y \ 10 | && rm -rf /var/lib/apt/lists/* \ 11 | && installPackage 12 | 13 | CMD ["check"] 14 | -------------------------------------------------------------------------------- /INWTRSync.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace,vignette 22 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2018-2019 2 | COPYRIGHT HOLDER: INWT Statistics GmbH 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(as.character,awss3) 4 | S3method(as.character,rsync) 5 | S3method(getData,default) 6 | S3method(getFile,awss3) 7 | S3method(getFile,default) 8 | S3method(listFiles,awss3) 9 | S3method(listFiles,default) 10 | S3method(print,awss3) 11 | S3method(print,rsync) 12 | S3method(removeAllFiles,default) 13 | S3method(removeFile,awss3) 14 | S3method(removeFile,default) 15 | S3method(sendAllFiles,awss3) 16 | S3method(sendAllFiles,default) 17 | S3method(sendFile,awss3) 18 | S3method(sendFile,default) 19 | S3method(sendObject,default) 20 | S3method(syncAllFiles,awss3) 21 | S3method(syncAllFiles,default) 22 | export(awss3) 23 | export(checkSystemResult) 24 | export(getData) 25 | export(getFile) 26 | export(listFiles) 27 | export(profileCreate) 28 | export(removeAllFiles) 29 | export(removeFile) 30 | export(rsync) 31 | export(rsynccli) 32 | export(sendAllFiles) 33 | export(sendFile) 34 | export(sendObject) 35 | export(syncAllFiles) 36 | import(data.table) 37 | -------------------------------------------------------------------------------- /R/awscli.R: -------------------------------------------------------------------------------- 1 | awscli <- function(src, dest, includes = NULL, excludes = NULL, args = "", profile = NULL, intern = FALSE) { 2 | constructArg <- function(x, s) { 3 | if (is.null(x)) { 4 | return(x) 5 | } 6 | paste(paste0(s, " \"", x, "\""), collapse = " ") 7 | } 8 | 9 | includes <- constructArg(includes, "--include") 10 | excludes <- constructArg(excludes, "--exclude") 11 | profile <- if (is.null(profile)) "" else paste("--profile", profile) 12 | dest <- paste("\"", dest, "\"", sep = "") 13 | src <- if (!is.null(src)) paste("\"", src, "\"", sep = "") else NULL 14 | 15 | command <- paste( 16 | "aws s3", 17 | args, 18 | excludes, 19 | includes, 20 | profile, 21 | src, 22 | dest 23 | ) 24 | # cat(command, "\n") 25 | 26 | status <- system(command, intern = intern, wait = TRUE, ignore.stdout = FALSE, ignore.stderr = FALSE) 27 | checkSystemResult(status) 28 | } 29 | -------------------------------------------------------------------------------- /R/awss3.R: -------------------------------------------------------------------------------- 1 | #' Connection object to a AWS S3 bucket 2 | #' 3 | #' Only methods specific to this class are documented here. For others the 4 | #' default method will work. This connection provides the same interface as 5 | #' \link{rsync}. 6 | #' 7 | #' @param dest,src (character) an s3 bucket, e.g. \code{s3://my-bucket} or a 8 | #' local directory 9 | #' @param profile (NULL|character|list) the name of a profile or a list defining 10 | #' a profile. In case of a list a new profile will be created which is 11 | #' persistent. A profile is created using \code{aws configure} and stores 12 | #' credentials for the user in plain text. 13 | #' @param force (logical) override profile if it exists. 14 | #' @param db (awss3) connection created with \code{awss3} 15 | #' @param fileName (character) a file name in dest/src 16 | #' @param validate (logical) if validation should take place 17 | #' @param verbose (logical) if TRUE print more information to the console 18 | #' @param recursive (logical) if TRUE print full names for files in sub folders 19 | #' @param args (character) pass additional args to aws cli. Currently only implemented for sendFile 20 | #' @param ... arguments passed to method 21 | #' 22 | #' @examples 23 | #' \dontrun{ 24 | #' awss3("s3://my-bucket", profile = list( 25 | #' name = "my-profile", # the name of the profile to generate 26 | #' aws_access_key_id = "my-access-key-id", 27 | #' aws_secret_access_key = "my-secret-access-key", 28 | #' region = "my-region" 29 | #' )) 30 | #' awss3("s3://my-bucket", profile = "my-profile") 31 | #' } 32 | #' 33 | #' @rdname awss3 34 | #' @export 35 | awss3 <- function(dest, src = getwd(), profile = NULL) { 36 | stopifnot( 37 | is.character(dest) && length(dest) == 1, 38 | is.character(src) && length(src) == 1, 39 | is.null(profile) || 40 | (is.character(profile) && length(profile) == 1 && profileExists(profile)) || 41 | (is.list(profile) && is.character(profile$name)) 42 | ) 43 | src <- if (isS3Bucket(src)) { 44 | sub("/$", "", src) 45 | } else { 46 | normalizePath(src, mustWork = TRUE) 47 | } 48 | dest <- if (isS3Bucket(dest)) { 49 | sub("/$", "", dest) 50 | } else { 51 | normalizePath(dest, mustWork = TRUE) 52 | } 53 | if (is.list(profile)) { 54 | profileCreate(profile, force = TRUE) 55 | profile <- profile$name 56 | } 57 | ret <- list( 58 | dest = dest, 59 | src = src, 60 | profile = profile 61 | ) 62 | class(ret) <- "awss3" 63 | ret 64 | } 65 | 66 | getProfile <- function(db, ...) { 67 | db$profile 68 | } 69 | 70 | isS3Bucket <- function(x) { 71 | grepl("^s3://", x) 72 | } 73 | 74 | #' @export 75 | print.awss3 <- function(x, ...) { 76 | xchar <- as.character(x) 77 | xchar <- paste(names(xchar), xchar, sep = ": ") 78 | xchar <- paste0("\n ", xchar) 79 | xchar <- paste(xchar, collapse = "") 80 | cat("AWS S3 bucket:", xchar, "\n") 81 | cat("Directory in destination:\n") 82 | print(listFiles(x)) 83 | invisible(x) 84 | } 85 | 86 | #' @export 87 | as.character.awss3 <- function(x, ...) { 88 | ret <- as.character.default(x) 89 | names(ret) <- names(x) 90 | ret 91 | } 92 | 93 | #' @export 94 | #' @rdname awss3 95 | profileCreate <- function(profile, force = FALSE) { 96 | name <- profile$name 97 | if (!force && profileExists(name)) { 98 | return(TRUE) 99 | } 100 | profile$name <- NULL 101 | for (el in names(profile)) { 102 | system(sprintf( 103 | "aws configure set %s %s --profile %s", 104 | el, profile[[el]], name 105 | )) 106 | } 107 | } 108 | 109 | profileExists <- function(profile) { 110 | cmd <- sprintf("aws configure list --profile %s || true", profile) 111 | res <- system(cmd, intern = TRUE) 112 | if (length(res) <= 3) FALSE else TRUE 113 | } 114 | -------------------------------------------------------------------------------- /R/getData.R: -------------------------------------------------------------------------------- 1 | #' @details 2 | #' \code{getData}: sync and load the contents of a file in \code{dest}. This 3 | #' can be a Rdata file or a csv or json. The file will be saved in \code{src}. 4 | #' 5 | #' @rdname rsync 6 | #' @export 7 | getData <- function(db, ...) { 8 | UseMethod("getData", db) 9 | } 10 | 11 | #' @rdname rsync 12 | #' @export 13 | getData.default <- function(db, fileName, verbose = FALSE, ...) { 14 | 15 | if (verbose == TRUE) { 16 | args <- "-ltvvx" 17 | } else { 18 | args <- "-ltx"} 19 | 20 | getFile(db, fileName) 21 | fileExtension <- tools::file_ext(fileName) 22 | fullFileName <- getSrcFile(db, fileName) 23 | fextMethod <- sprintf("load.%s", tolower(fileExtension)) 24 | fextMethod <- try(get(fextMethod, mode = "function"), silent = TRUE) 25 | if (inherits(fextMethod, "try-error")) 26 | stop(sprintf("No applicable method for '%s'", fileExtension)) 27 | fextMethod(fullFileName) 28 | 29 | } 30 | 31 | load.rdata <- function(fileName) { 32 | on.exit(try(close(con))) 33 | con <- file(fileName, 'rb') 34 | load(con, e <- new.env(parent = emptyenv())) 35 | as.list(e, all.names = TRUE) 36 | } 37 | 38 | load.csv <- function(fileName) { 39 | data.table::fread(fileName, showProgress = FALSE, data.table = FALSE) 40 | } 41 | 42 | load.json <- function(fileName) { 43 | jsonlite::read_json(fileName, simplifyVector = TRUE) 44 | } 45 | -------------------------------------------------------------------------------- /R/getFile.R: -------------------------------------------------------------------------------- 1 | #' @details 2 | #' \code{getFile} downloads a file from dest and saves it in src. 3 | #' 4 | #' @rdname rsync 5 | #' @export 6 | getFile <- function(db, ...) { 7 | UseMethod("getFile", db) 8 | } 9 | 10 | #' @rdname rsync 11 | #' @export 12 | getFile.default <- function(db, fileName, validate = FALSE, verbose = FALSE, ...) { 13 | 14 | args <- if (verbose == TRUE) "-ltrvvx" else "-ltrx" 15 | args <- paste(args, getArgs(db)) 16 | 17 | file <- getDestFile(db, fileName) 18 | to <- getSrc(db) 19 | pre <- getPre(db) 20 | 21 | rsynccli(file, to, args = args, pre = pre) 22 | 23 | if (validate) validateFile(db, fileName) 24 | 25 | db 26 | } 27 | 28 | #' @rdname awss3 29 | #' @export 30 | getFile.awss3 <- function(db, fileName, validate = FALSE, verbose = FALSE, ...) { 31 | 32 | args <- if (!verbose) "--quiet --no-progress --only-show-errors" else "" 33 | args <- paste("sync ", args) 34 | 35 | dest <- getDest(db) 36 | src <- getSrc(db) 37 | profile <- getProfile(db) 38 | 39 | awscli(dest, src, args = args, excludes = "*", includes = fileName, profile = profile) 40 | 41 | if (validate) validateFile(db, fileName) 42 | 43 | db 44 | } 45 | -------------------------------------------------------------------------------- /R/listFiles.R: -------------------------------------------------------------------------------- 1 | #' @rdname rsync 2 | #' @export 3 | listFiles <- function(db, ...) { 4 | UseMethod("listFiles", db) 5 | } 6 | 7 | #' @import data.table 8 | #' @rdname rsync 9 | #' @export 10 | listFiles.default <- function(db, ...) { 11 | pre <- getPre(db) 12 | to <- getDest(db) 13 | args <- getArgs(db) 14 | 15 | dir <- rsynccli(NULL, to, args = args, pre = pre, intern = TRUE) 16 | dir <- dat::extract(dir, ~ !grepl("\\.$", .)) 17 | if (length(dir) == 0) { 18 | return(emptyDir()) 19 | } 20 | 21 | dir <- lapply(dir, strsplitOnSpace, maxSplits = 5) 22 | dir <- as.data.frame(do.call(rbind, dir)) 23 | names(dir) <- c("permission", "size", "date", "time", "name") 24 | dir <- dat::replace(dir, "date", gsub("/", "-", dir$date)) 25 | dir <- dat::mutar(dir, lastModified ~ as.POSIXct(paste(date, time))) 26 | dir <- dat::mutar(dir, size ~ as.numeric(gsub(",", "", size))) 27 | dir <- dat::mutar(dir, name ~ as.character(name)) 28 | dir <- dat::extract(dir, c("name", "lastModified", "size")) 29 | dir 30 | } 31 | 32 | 33 | strsplitOnSpace <- function(txt, maxSplits) { 34 | # split on whitespaces, but only using at most the first (maxSplits - 1) 35 | # splits (to give at most maxSplits output columns) 36 | possibleSplits <- length(gregexpr("[[:space:]]+", txt)[[1]]) 37 | nSplits <- min(possibleSplits, maxSplits - 1) 38 | # Regular expression to extract whitespace seperated fields 39 | rgxp <- paste( 40 | c(rep("([^[:space:]]+)", nSplits), "(.*)"), 41 | collapse = "[[:space:]]+" 42 | ) 43 | regmatches(txt, regexec(rgxp, txt))[[1]][-1] 44 | } 45 | 46 | emptyDir <- function() { 47 | data.frame( 48 | name = character(0), 49 | lastModified = as.POSIXct(character(0)), 50 | size = integer(0), 51 | stringsAsFactors = FALSE 52 | ) 53 | } 54 | 55 | #' @rdname awss3 56 | #' @export 57 | listFiles.awss3 <- function(db, recursive = FALSE, ...) { 58 | dest <- getDest(db) 59 | profile <- getProfile(db) 60 | if (!isS3Bucket(dest)) { 61 | return(NextMethod()) 62 | } 63 | args <- if (recursive) "ls --recursive" else "ls" 64 | dir <- awscli(NULL, dest, args = args, profile = profile, intern = TRUE) 65 | dir <- dat::extract(dir, ~ !grepl("\\.$", .)) 66 | if (length(dir) == 0) { 67 | return(emptyDir()) 68 | } 69 | 70 | dir <- lapply(dir, strsplitOnSpaceForAWSS3) 71 | dir <- lapply(dir, sub, pattern = "/$", replacement = "") 72 | dir <- lapply(dir, addMissingCol) 73 | dir <- do.call(rbind, dir) 74 | dir <- as.data.frame(dir) 75 | names(dir) <- c("date", "time", "size", "name") 76 | dir <- dat::replace(dir, "date", gsub("/", "-", dir$date)) 77 | dir <- dat::mutar(dir, lastModified ~ toPOSIX(paste(date, time))) 78 | dir <- dat::mutar(dir, size ~ suppressWarnings(as.numeric(gsub(",", "", size)))) 79 | dir <- dat::mutar(dir, name ~ as.character(name)) 80 | dir <- dat::extract(dir, c("name", "lastModified", "size")) 81 | dir 82 | } 83 | 84 | addMissingCol <- function(x) { 85 | if (length(x) == 3) { 86 | c("", x) 87 | } # add an empty time 88 | else { 89 | x 90 | } 91 | } 92 | 93 | strsplitOnSpaceForAWSS3 <- function(x) { 94 | if (grepl("PRE", x)) { 95 | c("", strsplitOnSpace(x, 2)) 96 | } else { 97 | strsplitOnSpace(x, 4) 98 | } 99 | } 100 | 101 | toPOSIX <- function(x) { 102 | # whitespaces are NAs 103 | as.POSIXct(ifelse(grepl("\\S", x), x, NA)) 104 | } 105 | -------------------------------------------------------------------------------- /R/removeAllFiles.R: -------------------------------------------------------------------------------- 1 | #' @details 2 | #' \code{removeAllFiles} remove all entries from \code{dest}. \code{src} will 3 | #' not be affected. 4 | #' 5 | #' @rdname rsync 6 | #' @export 7 | removeAllFiles <- function(db, ...) { 8 | UseMethod("removeAllFiles", db) 9 | } 10 | 11 | #' @rdname rsync 12 | #' @export 13 | removeAllFiles.default <- function(db, verbose = FALSE, ...) { 14 | dat <- listFiles(db, recursive = TRUE) 15 | entries <- dat$name 16 | removeFile(db, entries, verbose = verbose, ...) 17 | } 18 | -------------------------------------------------------------------------------- /R/removeFile.R: -------------------------------------------------------------------------------- 1 | #' \code{removeFile} Remove a file from \code{dest}. 2 | #' 3 | #' @rdname rsync 4 | #' @export 5 | removeFile <- function(db, ...) { 6 | UseMethod("removeFile", db) 7 | } 8 | 9 | #' @rdname rsync 10 | #' @export 11 | removeFile.default <- function(db, fileName, verbose = FALSE, ...) { 12 | if (length(fileName) == 0) { 13 | return(db) 14 | } 15 | 16 | on.exit(try(file.remove(emptyDir), silent = TRUE)) 17 | emptyDir <- paste0(tempdir(), "/empty/") 18 | dir.create(emptyDir) 19 | 20 | args <- if (verbose) "-rvv --delete" else "-r --delete" 21 | args <- paste(args, getArgs(db)) 22 | pre <- getPre(db) 23 | to <- getDest(db) 24 | file <- emptyDir 25 | 26 | rsynccli(file, to, includes = fileName, excludes = "*", args = args, pre = pre) 27 | db 28 | } 29 | 30 | #' @rdname awss3 31 | #' @export 32 | removeFile.awss3 <- function(db, fileName, verbose = FALSE, ...) { 33 | if (length(fileName) == 0) { 34 | return(db) 35 | } 36 | 37 | fileName <- gsub("/$", "/*", fileName) 38 | 39 | dest <- getDest(db) 40 | profile <- getProfile(db) 41 | if (!isS3Bucket(dest)) { 42 | return(NextMethod()) 43 | } 44 | 45 | args <- if (!verbose) "--quiet --only-show-errors --recursive" else "--recursive" 46 | args <- paste("rm", args) 47 | 48 | awscli(NULL, dest, includes = fileName, excludes = "*", args = args, profile = profile) 49 | db 50 | } 51 | -------------------------------------------------------------------------------- /R/rsync.R: -------------------------------------------------------------------------------- 1 | #' API for the CLI program rsync 2 | #' 3 | #' Setup a rsync configuration. The configuration object can be used for access 4 | #' to a folder. 5 | #' 6 | #' @param dest (character) the address to the rsync daemon or a folder. 7 | #' @param src (character) a folder. 8 | #' @param password (character|NULL) a password or file name in case a rsync 9 | #' daemon is used. 10 | #' @param db (rsync) an object of class 'rsync' initialized with \code{rsync}. 11 | #' @param fileName (character) a file name that exists in \code{src} 12 | #' @param validate (logical) if the file in dest and src should be validated 13 | #' using a sha256 check sum. 14 | #' @param verbose (logical) if we use 'vorbose' as option in the cli. 15 | #' @param object (ANY) any R object you wish to store. 16 | #' @param objectName (character) the name used to store the object. The file 17 | #' extension will always be a 'Rdata'. 18 | #' @param ssh (character|NULL) argument is passed as '-e' option on the command 19 | #' line. Can be used to further specify ssh settings. 20 | #' @param sshProg (character|NULL) arguments sets the environment variable 21 | #' 'RSYNC_CONNECT_PROG' during the call. Can be used to setup a ssh connection 22 | #' to a remote rsync daemon. 23 | #' @param ... arguments passed to methods. 24 | #' 25 | #' @details 26 | #' \code{rsync} is a command line tool. For details see 27 | #' \url{https://rsync.samba.org/}. From the documentation: 28 | #' 29 | #' \emph{There are two different ways for rsync to contact a remote system: 30 | #' using a remote-shell program as the transport (such as ssh or rsh) or 31 | #' contacting an rsync daemon directly via TCP. The remote-shell transport is 32 | #' used whenever the source or destination path contains a single colon (:) 33 | #' separator after a host specification. Contacting an rsync daemon directly 34 | #' happens when the source or destination path contains a double colon (::) 35 | #' separator after a host specification, OR when an rsync:// URL is specified 36 | #' (see also the "USING RSYNC-DAEMON FEATURES VIA A REMOTE-SHELL CONNECTION" 37 | #' section for an exception to this latter rule).} 38 | #' 39 | #' Currently the rsync interface in this package only allows for remote 40 | #' locations in the destination. 41 | #' 42 | #' \emph{You may also establish a daemon connection using a program as a proxy 43 | #' by setting the environment variable RSYNC_CONNECT_PROG to the commands 44 | #' you wish to run in place of making a direct socket connection.} This can be 45 | #' done using the \code{sshProg} argument. 46 | #' 47 | #' @examples 48 | #' \dontrun{ 49 | #' ## Please consider examples in the Readme of this project. To get there run: 50 | #' browseURL("https://github.com/INWTlab/rsync") 51 | #' 52 | #' ## Using rsync locally 53 | #' rsync("~/someFolder") 54 | #' 55 | #' ## Examples for remote connections 56 | #' rsync("rsync://user@host:port/volume", password = "~/my-pwd") 57 | #' rsync("user@host:~/", ssh = "ssh -i./my-identity-file") 58 | #' ### requires (netcat) on the host 59 | #' rsync("user@host::volume", sshProg = "ssh -i./my-identity-file host nc %H 873") 60 | #' } 61 | #' 62 | #' @rdname rsync 63 | #' @export 64 | rsync <- function(dest, src = getwd(), password = NULL, ssh = NULL, sshProg = NULL) { 65 | stopifnot( 66 | is.character(dest) && length(dest) == 1, 67 | is.character(src) && length(src) == 1, 68 | is.null(password) || is.character(password) && length(password) == 1 69 | ) 70 | src <- normalizePath(src, mustWork = TRUE) 71 | dest <- if (grepl(":", dest)) 72 | sub("/$", "", dest) else normalizePath(dest, mustWork = TRUE) 73 | ret <- list( 74 | dest = dest, 75 | src = src, 76 | password = password, 77 | ssh = ssh, 78 | sshProg = sshProg 79 | ) 80 | class(ret) <- "rsync" 81 | ret 82 | } 83 | 84 | getPre <- function(db) { 85 | pre <- if (!is.null(db$password)) { 86 | pwd <- db$password 87 | pwd <- if (file.exists(pwd)) sprintf("$(cat %s)", pwd) else pwd 88 | sprintf("RSYNC_PASSWORD=\"%s\" ", pwd) 89 | } else NULL 90 | pre <- paste0(pre, if (!is.null(db$sshProg)) { 91 | paste0("RSYNC_CONNECT_PROG=\"", db$sshProg, "\"") 92 | }) 93 | pre 94 | } 95 | 96 | getArgs <- function(db) { 97 | ## put further command line arguments together 98 | if (!is.null(db$ssh)) { 99 | paste0("-e \"", db$ssh, "\"") 100 | } else { 101 | NULL 102 | } 103 | } 104 | 105 | getDestFile <- function(db, fileName) { 106 | paste0(sub("/+$", "", db$dest), '/', fileName) 107 | } 108 | 109 | getSrcFile <- function(db, fileName) { 110 | paste0(sub("/+$", "", db$src), '/', fileName) 111 | } 112 | 113 | getDest <- function(db) paste0(db$dest, "/") 114 | getSrc <- function(db) paste0(db$src, "/") 115 | 116 | #' @export 117 | print.rsync <- function(x, ...) { 118 | xchar <- paste(c("src", "dest"), c(getSrc(x), getDest(x)), sep = ": ") 119 | xchar <- paste0("\n ", xchar) 120 | xchar <- paste(xchar, collapse = "") 121 | cat("Rsync server:", xchar, "\n") 122 | cat("Directory in destination:\n") 123 | print(listFiles(x)) 124 | invisible(x) 125 | } 126 | 127 | #' @export 128 | as.character.rsync <- function(x, ...) { 129 | if (!is.null(x$password)) x$password <- "****" 130 | ret <- as.character.default(x) 131 | names(ret) <- names(x) 132 | ret 133 | } 134 | -------------------------------------------------------------------------------- /R/rsynccli.R: -------------------------------------------------------------------------------- 1 | #' Interface to rsync cli-tool 2 | #' 3 | #' Calls the CLI-program 'rsync'. 4 | #' 5 | #' @param file (character) source. 6 | #' @param to (character) destination. 7 | #' @param includes,excludes (character) with length >=1 or (NULL). 8 | #' @param args (character) arguments passed to rsync. Default is '-rltvx' and 9 | #' works for most cases. 10 | #' @param pre (character) something that is pasted in front of the 'rsync' 11 | #' command. E.g. a password. 12 | #' @param intern (logical) passed to \link{system}. 13 | #' 14 | #' @rdname rsynccli 15 | #' @export 16 | rsynccli <- function(file, to, includes = NULL, excludes = NULL, args = "-rltvx", pre = NULL, intern = FALSE) { 17 | constructArg <- function(x, s) { 18 | if (is.null(x)) { 19 | return(x) 20 | } 21 | paste(paste0(s, " \"", x, "\""), collapse = " ") 22 | } 23 | 24 | includes <- constructArg(includes, "--include") 25 | excludes <- constructArg(excludes, "--exclude") 26 | to <- gsub(" ", "\\\\ ", to) 27 | file <- if (!is.null(file)) gsub(" ", "\\\\ ", file) else NULL 28 | 29 | command <- paste( 30 | pre, 31 | "rsync", 32 | args, 33 | includes, 34 | excludes, 35 | file, 36 | to 37 | ) 38 | 39 | status <- system(command, intern = intern, wait = TRUE, ignore.stdout = FALSE, ignore.stderr = FALSE) 40 | checkSystemResult(status) 41 | } 42 | 43 | 44 | #' Check System Command Result for Exit Code 45 | #' 46 | #' Evaluates the result from R's \code{system()} function and checks for a 47 | #' non-zero exit status. If the system command failed (i.e., returned a non-zero 48 | #' exit status), the function throws an error. If the result contains the 49 | #' command's output, it is returned. 50 | #' 51 | #' @param result The result of a \code{system()} function execution. This can be: 52 | #' \itemize{ 53 | #' \item A character vector containing the command's output. 54 | #' \item A numeric value representing the exit status code. 55 | #' \item An object with a \code{status} attribute. 56 | #' } 57 | #' @return 58 | #' \itemize{ 59 | #' \item If \code{result} is a character vector (command output) and has no 60 | #' \code{status} attribute, returns the output. 61 | #' \item If \code{result} is numeric (exit status code), returns the status 62 | #' code. 63 | #' \item If the command failed (non-zero exit status), the function stops 64 | #' with an error message. 65 | #' } 66 | #' @export 67 | checkSystemResult <- function(result) { 68 | if (is.character(result) && is.null(attr(result, "status"))) { 69 | sys_output <- result 70 | return(sys_output) 71 | } 72 | 73 | if (is.numeric(result)) { 74 | status <- result 75 | } else { 76 | status <- if (!is.null(attr(result, "status"))) attr(result, "status") else 0 77 | } 78 | 79 | if (status != 0) stop("Command failed with status: ", status) 80 | 81 | return(status) 82 | } 83 | -------------------------------------------------------------------------------- /R/sendAllFiles.R: -------------------------------------------------------------------------------- 1 | #' @details 2 | #' \code{sendAllFiles} Sends all files in \code{src} to \code{dest} using \code{sendFile}. 3 | #' 4 | #' @rdname rsync 5 | #' @export 6 | sendAllFiles <- function(db, ...) { 7 | UseMethod("sendAllFiles", db) 8 | } 9 | 10 | #' @rdname rsync 11 | #' @export 12 | sendAllFiles.default <- function(db, ...) { 13 | sendFile(db, fileName = ".", ...) 14 | } 15 | 16 | #' @rdname awss3 17 | #' @export 18 | sendAllFiles.awss3 <- function(db, verbose = FALSE, ...) { 19 | args <- if (!verbose) "--quiet --no-progress --only-show-errors" else "" 20 | args <- paste("sync", args) 21 | 22 | src <- getSrc(db) 23 | dest <- getDest(db) 24 | profile <- getProfile(db) 25 | 26 | awscli(src, dest, args = args, profile = profile) 27 | db 28 | } 29 | -------------------------------------------------------------------------------- /R/sendFile.R: -------------------------------------------------------------------------------- 1 | #' @details 2 | #' \code{sendFile} Sends a file to a rsync object. 3 | #' 4 | #' @rdname rsync 5 | #' @export 6 | sendFile <- function(db, ...) { 7 | UseMethod("sendFile", db) 8 | } 9 | 10 | #' @rdname rsync 11 | #' @export 12 | sendFile.default <- function(db, fileName, validate = FALSE, verbose = FALSE, ...) { 13 | stopifnot(length(fileName) == 1) 14 | 15 | args <- if (verbose == TRUE) "-ltrvvx" else "-ltrx" 16 | args <- paste(args, getArgs(db)) 17 | src <- paste0(getSrc(db), fileName) 18 | dest <- getDest(db) 19 | pre <- getPre(db) 20 | 21 | stopifnot(file.exists(src)) 22 | 23 | rsynccli(src, dest, args = args, pre = pre) 24 | 25 | if (validate) validateFile(db, fileName) 26 | db 27 | } 28 | 29 | #' @rdname awss3 30 | #' @export 31 | sendFile.awss3 <- function(db, fileName, validate = FALSE, verbose = FALSE, args = "", ...) { 32 | args <- if (!verbose) paste("--quiet --no-progress --only-show-errors", args) else args 33 | args <- paste("sync", args) 34 | 35 | src <- getSrc(db) 36 | dest <- getDest(db) 37 | profile <- getProfile(db) 38 | 39 | awscli(src, dest, args = args, excludes = "*", includes = fileName, profile = profile) 40 | 41 | if (validate) validateFile(db, fileName) 42 | db 43 | } 44 | -------------------------------------------------------------------------------- /R/sendObject.R: -------------------------------------------------------------------------------- 1 | #' @details 2 | #' \code{sendObject} sends an object (from the environment) 3 | #' to a rsync target. This abstracts a pattern where you would use \link{save} 4 | #' followed by \code{sendFile}. The reverse is done using \code{getObject} 5 | #' 6 | #' @rdname rsync 7 | #' @export 8 | sendObject <- function(db, ...) { 9 | UseMethod("sendObject", db) 10 | } 11 | 12 | #' @rdname rsync 13 | #' @export 14 | sendObject.default <- function(db, object, objectName = as.character(substitute(object)), validate = FALSE, verbose = FALSE, ...) { 15 | 16 | args <- if (verbose) "-ltvvx" else "-ltx" 17 | assign(objectName, object) 18 | fileName <- paste0(objectName, ".Rdata") 19 | save( 20 | list = objectName, 21 | file = file <- getSrcFile(db, fileName), 22 | compress = TRUE 23 | ) 24 | sendFile(db, fileName, validate = validate, verbose = verbose, ...) 25 | 26 | } 27 | -------------------------------------------------------------------------------- /R/syncAllFiles.R: -------------------------------------------------------------------------------- 1 | #' @details 2 | #' \code{syncAllFiles} Syncs all files in \code{src} to \code{dest}. Files that exist in \code{dest} but not in \code{src} will be deleted. 3 | #' 4 | #' @rdname rsync 5 | #' @export 6 | syncAllFiles <- function(db, ...) { 7 | UseMethod("syncAllFiles", db) 8 | } 9 | 10 | #' @rdname rsync 11 | #' @export 12 | syncAllFiles.default <- function(db, verbose = FALSE, ...) { 13 | 14 | args <- if (verbose) "-ltrvvx" else "-ltrx" 15 | args <- paste(args, "--delete") 16 | 17 | src <- paste0(getSrc(db), ".") 18 | dest <- getDest(db) 19 | pre <- getPre(db) 20 | 21 | rsynccli(src, dest, args = args, pre = pre) 22 | db 23 | } 24 | 25 | #' @rdname awss3 26 | #' @export 27 | syncAllFiles.awss3 <- function(db, verbose = FALSE, ...) { 28 | 29 | args <- if (!verbose) "--quiet --no-progress --only-show-errors" else "" 30 | args <- paste("sync", args, "--delete") 31 | 32 | src <- getSrc(db) 33 | dest <- getDest(db) 34 | profile <- getProfile(db) 35 | 36 | awscli(src, dest, args = args, profile = profile) 37 | db 38 | 39 | } 40 | -------------------------------------------------------------------------------- /R/validateFile.R: -------------------------------------------------------------------------------- 1 | validateFile <- function(db, fileName, ...) { 2 | 3 | on.exit(try({close(srcFile);close(destFile);unlink(db1$src, recursive = TRUE)}, silent = TRUE)) 4 | 5 | # We download the file a second time into a different location. Then we 6 | # compare if this file is identical to what we have in src. Other options 7 | # would be welcome. 8 | 9 | db1 <- db 10 | db1$src <- paste0(tempdir(), "/", paste0(sample(letters, 8), collapse = ""), "/") 11 | dir.create(db1$src) 12 | getFile(db1, fileName, validate = FALSE) 13 | srcFile <- file(getSrcFile(db, fileName), open = "rb") 14 | destFile <- file(getSrcFile(db1, fileName), open = "rb") 15 | 16 | if (base::identical(openssl::sha256(srcFile), openssl::sha256(destFile))) { 17 | message("Sync successful: Local and host file are identical!") 18 | TRUE 19 | } else { 20 | warning("Src and dest file are not identical!") 21 | FALSE 22 | } 23 | 24 | } 25 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | [![R-CMD-check](https://github.com/INWTlab/rsync/actions/workflows/R-CMD-check.yaml/badge.svg?branch=main)](https://github.com/INWTlab/rsync/actions/workflows/R-CMD-check.yaml) 2 | 3 | ## Rsync as R-Package 4 | 5 | `rsync` is a open source file-copying tool that is freely available under the 6 | GNU General Public License. This is a R package providing an API to rsync from 7 | R. 8 | 9 | ## Why use rsync: 10 | 11 | Rsync is a tool, which is used with Unix systems and allows efficient 12 | transferring and synchronizing of files across systems. It is widely 13 | used for making backups, copying files or mirroring them. 14 | 15 | Working with Rsync offers nice benefits, as it is: 16 | - fast 17 | - works remotly and locally 18 | - minimizes data transfer, as it only transfers the changes within the files 19 | - supports copying links, devices, owners, groups, and permissions 20 | 21 | For further information about rsync, please visit https://rsync.samba.org/. 22 | 23 | Similar and very popular alternatives exist. E.g. in contrast to AWS S3 the 24 | solution here: 25 | 26 | - Is free, 27 | - fast(er), if you stay in your local network, 28 | - but, S3 provides versioning, which is very neat. 29 | 30 | ## Installation: 31 | 32 | The rsync R package can be downloaded and installed by running the following 33 | command from the R console: 34 | 35 | ```{R, eval = FALSE} 36 | devtools::install_github("INWTlab/rsync") 37 | ``` 38 | 39 | Make sure you have the `rsync` command line tool available. 40 | 41 | 42 | ## Examples 43 | 44 | You create a rsync configuration using: 45 | 46 | ```{R} 47 | library(rsync) 48 | dir.create("destination") 49 | dir.create("source") 50 | dest <- rsync(dest = "destination", src = "source") 51 | dest 52 | ``` 53 | 54 | In the case of an rsync daemon you can also supply a password. The way you think 55 | about transactions is that we have a destination folder with which we want to 56 | interact. All methods provided by this package will always operate on the 57 | destination. It will not change the source, in most cases. An exception is 58 | `sendObject`, that will also create a file in source. 59 | 60 | ```{r} 61 | x <- 1 62 | y <- 2 63 | sendObject(dest, x) 64 | sendObject(dest, y) 65 | ``` 66 | 67 | We can see that we have added two new files. These two files now exist in the 68 | source directory and the destination. The following examples illustrate the core 69 | features of the package: 70 | 71 | ```{r} 72 | removeAllFiles(dest) # will not change source 73 | sendFile(dest, "x.Rdata") # so we can still send the files 74 | removeAllFiles(src <- rsync("source")) # make the source a destination 75 | getFile(dest, "x.Rdata") 76 | src 77 | ``` 78 | 79 | ```{r echo = FALSE, results='hide'} 80 | # Clean-up 81 | removeAllFiles(src) 82 | removeAllFiles(dest) 83 | file.remove("destination") 84 | file.remove("source") 85 | ``` 86 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![R-CMD-check](https://github.com/INWTlab/rsync/actions/workflows/R-CMD-check.yaml/badge.svg?branch=main)](https://github.com/INWTlab/rsync/actions/workflows/R-CMD-check.yaml) 2 | 3 | ## Rsync as R-Package 4 | 5 | `rsync` is a open source file-copying tool that is freely available under the 6 | GNU General Public License. This is a R package providing an API to rsync from 7 | R. 8 | 9 | ## Why use rsync: 10 | 11 | Rsync is a tool, which is used with Unix systems and allows efficient 12 | transferring and synchronizing of files across systems. It is widely 13 | used for making backups, copying files or mirroring them. 14 | 15 | Working with Rsync offers nice benefits, as it is: 16 | - fast 17 | - works remotly and locally 18 | - minimizes data transfer, as it only transfers the changes within the files 19 | - supports copying links, devices, owners, groups, and permissions 20 | 21 | For further information about rsync, please visit https://rsync.samba.org/. 22 | 23 | Similar and very popular alternatives exist. E.g. in contrast to AWS S3 the 24 | solution here: 25 | 26 | - Is free, 27 | - fast(er), if you stay in your local network, 28 | - but, S3 provides versioning, which is very neat. 29 | 30 | ## Installation: 31 | 32 | The rsync R package can be downloaded and installed by running the following 33 | command from the R console: 34 | 35 | 36 | ``` r 37 | devtools::install_github("INWTlab/rsync") 38 | ``` 39 | 40 | Make sure you have the `rsync` command line tool available. 41 | 42 | 43 | ## Examples 44 | 45 | You create a rsync configuration using: 46 | 47 | 48 | ``` r 49 | library(rsync) 50 | dir.create("destination") 51 | dir.create("source") 52 | dest <- rsync(dest = "destination", src = "source") 53 | dest 54 | ``` 55 | 56 | ``` 57 | ## Rsync server: 58 | ## src: /home/ljabel/Dokumente/git-work/INWTlab/rsync/source/ 59 | ## dest: /home/ljabel/Dokumente/git-work/INWTlab/rsync/destination/ 60 | ## Directory in destination: 61 | ## [1] name lastModified size 62 | ## <0 rows> (or 0-length row.names) 63 | ``` 64 | 65 | In the case of an rsync daemon you can also supply a password. The way you think 66 | about transactions is that we have a destination folder with which we want to 67 | interact. All methods provided by this package will always operate on the 68 | destination. It will not change the source, in most cases. An exception is 69 | `sendObject`, that will also create a file in source. 70 | 71 | 72 | ``` r 73 | x <- 1 74 | y <- 2 75 | sendObject(dest, x) 76 | ``` 77 | 78 | ``` 79 | ## Rsync server: 80 | ## src: /home/ljabel/Dokumente/git-work/INWTlab/rsync/source/ 81 | ## dest: /home/ljabel/Dokumente/git-work/INWTlab/rsync/destination/ 82 | ## Directory in destination: 83 | ## name lastModified size 84 | ## 1 x.Rdata 2024-10-23 11:41:07 70 85 | ``` 86 | 87 | ``` r 88 | sendObject(dest, y) 89 | ``` 90 | 91 | ``` 92 | ## Rsync server: 93 | ## src: /home/ljabel/Dokumente/git-work/INWTlab/rsync/source/ 94 | ## dest: /home/ljabel/Dokumente/git-work/INWTlab/rsync/destination/ 95 | ## Directory in destination: 96 | ## name lastModified size 97 | ## 1 x.Rdata 2024-10-23 11:41:07 70 98 | ## 2 y.Rdata 2024-10-23 11:41:07 69 99 | ``` 100 | 101 | We can see that we have added two new files. These two files now exist in the 102 | source directory and the destination. The following examples illustrate the core 103 | features of the package: 104 | 105 | 106 | ``` r 107 | removeAllFiles(dest) # will not change source 108 | ``` 109 | 110 | ``` 111 | ## Rsync server: 112 | ## src: /home/ljabel/Dokumente/git-work/INWTlab/rsync/source/ 113 | ## dest: /home/ljabel/Dokumente/git-work/INWTlab/rsync/destination/ 114 | ## Directory in destination: 115 | ## [1] name lastModified size 116 | ## <0 rows> (or 0-length row.names) 117 | ``` 118 | 119 | ``` r 120 | sendFile(dest, "x.Rdata") # so we can still send the files 121 | ``` 122 | 123 | ``` 124 | ## Rsync server: 125 | ## src: /home/ljabel/Dokumente/git-work/INWTlab/rsync/source/ 126 | ## dest: /home/ljabel/Dokumente/git-work/INWTlab/rsync/destination/ 127 | ## Directory in destination: 128 | ## name lastModified size 129 | ## 1 x.Rdata 2024-10-23 11:41:07 70 130 | ``` 131 | 132 | ``` r 133 | removeAllFiles(src <- rsync("source")) # make the source a destination 134 | ``` 135 | 136 | ``` 137 | ## Rsync server: 138 | ## src: /home/ljabel/Dokumente/git-work/INWTlab/rsync/ 139 | ## dest: /home/ljabel/Dokumente/git-work/INWTlab/rsync/source/ 140 | ## Directory in destination: 141 | ## [1] name lastModified size 142 | ## <0 rows> (or 0-length row.names) 143 | ``` 144 | 145 | ``` r 146 | getFile(dest, "x.Rdata") 147 | ``` 148 | 149 | ``` 150 | ## Rsync server: 151 | ## src: /home/ljabel/Dokumente/git-work/INWTlab/rsync/source/ 152 | ## dest: /home/ljabel/Dokumente/git-work/INWTlab/rsync/destination/ 153 | ## Directory in destination: 154 | ## name lastModified size 155 | ## 1 x.Rdata 2024-10-23 11:41:07 70 156 | ``` 157 | 158 | ``` r 159 | src 160 | ``` 161 | 162 | ``` 163 | ## Rsync server: 164 | ## src: /home/ljabel/Dokumente/git-work/INWTlab/rsync/ 165 | ## dest: /home/ljabel/Dokumente/git-work/INWTlab/rsync/source/ 166 | ## Directory in destination: 167 | ## name lastModified size 168 | ## 1 x.Rdata 2024-10-23 11:41:07 70 169 | ``` 170 | 171 | 172 | -------------------------------------------------------------------------------- /man/awss3.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/awss3.R, R/getFile.R, R/listFiles.R, 3 | % R/removeFile.R, R/sendAllFiles.R, R/sendFile.R, R/syncAllFiles.R 4 | \name{awss3} 5 | \alias{awss3} 6 | \alias{profileCreate} 7 | \alias{getFile.awss3} 8 | \alias{listFiles.awss3} 9 | \alias{removeFile.awss3} 10 | \alias{sendAllFiles.awss3} 11 | \alias{sendFile.awss3} 12 | \alias{syncAllFiles.awss3} 13 | \title{Connection object to a AWS S3 bucket} 14 | \usage{ 15 | awss3(dest, src = getwd(), profile = NULL) 16 | 17 | profileCreate(profile, force = FALSE) 18 | 19 | \method{getFile}{awss3}(db, fileName, validate = FALSE, verbose = FALSE, ...) 20 | 21 | \method{listFiles}{awss3}(db, recursive = FALSE, ...) 22 | 23 | \method{removeFile}{awss3}(db, fileName, verbose = FALSE, ...) 24 | 25 | \method{sendAllFiles}{awss3}(db, verbose = FALSE, ...) 26 | 27 | \method{sendFile}{awss3}(db, fileName, validate = FALSE, verbose = FALSE, args = "", ...) 28 | 29 | \method{syncAllFiles}{awss3}(db, verbose = FALSE, ...) 30 | } 31 | \arguments{ 32 | \item{dest, src}{(character) an s3 bucket, e.g. \code{s3://my-bucket} or a 33 | local directory} 34 | 35 | \item{profile}{(NULL|character|list) the name of a profile or a list defining 36 | a profile. In case of a list a new profile will be created which is 37 | persistent. A profile is created using \code{aws configure} and stores 38 | credentials for the user in plain text.} 39 | 40 | \item{force}{(logical) override profile if it exists.} 41 | 42 | \item{db}{(awss3) connection created with \code{awss3}} 43 | 44 | \item{fileName}{(character) a file name in dest/src} 45 | 46 | \item{validate}{(logical) if validation should take place} 47 | 48 | \item{verbose}{(logical) if TRUE print more information to the console} 49 | 50 | \item{...}{arguments passed to method} 51 | 52 | \item{recursive}{(logical) if TRUE print full names for files in sub folders} 53 | 54 | \item{args}{(character) pass additional args to aws cli. Currently only implemented for sendFile} 55 | } 56 | \description{ 57 | Only methods specific to this class are documented here. For others the 58 | default method will work. This connection provides the same interface as 59 | \link{rsync}. 60 | } 61 | \examples{ 62 | \dontrun{ 63 | awss3("s3://my-bucket", profile = list( 64 | name = "my-profile", # the name of the profile to generate 65 | aws_access_key_id = "my-access-key-id", 66 | aws_secret_access_key = "my-secret-access-key", 67 | region = "my-region" 68 | )) 69 | awss3("s3://my-bucket", profile = "my-profile") 70 | } 71 | 72 | } 73 | -------------------------------------------------------------------------------- /man/checkSystemResult.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rsynccli.R 3 | \name{checkSystemResult} 4 | \alias{checkSystemResult} 5 | \title{Check System Command Result for Exit Code} 6 | \usage{ 7 | checkSystemResult(result) 8 | } 9 | \arguments{ 10 | \item{result}{The result of a \code{system()} function execution. This can be: 11 | \itemize{ 12 | \item A character vector containing the command's output. 13 | \item A numeric value representing the exit status code. 14 | \item An object with a \code{status} attribute. 15 | }} 16 | } 17 | \value{ 18 | \itemize{ 19 | \item If \code{result} is a character vector (command output) and has no 20 | \code{status} attribute, returns the output. 21 | \item If \code{result} is numeric (exit status code), returns the status 22 | code. 23 | \item If the command failed (non-zero exit status), the function stops 24 | with an error message. 25 | } 26 | } 27 | \description{ 28 | Evaluates the result from R's \code{system()} function and checks for a 29 | non-zero exit status. If the system command failed (i.e., returned a non-zero 30 | exit status), the function throws an error. If the result contains the 31 | command's output, it is returned. 32 | } 33 | -------------------------------------------------------------------------------- /man/rsync.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getData.R, R/getFile.R, R/listFiles.R, 3 | % R/removeAllFiles.R, R/removeFile.R, R/rsync.R, R/sendAllFiles.R, 4 | % R/sendFile.R, R/sendObject.R, R/syncAllFiles.R 5 | \name{getData} 6 | \alias{getData} 7 | \alias{getData.default} 8 | \alias{getFile} 9 | \alias{getFile.default} 10 | \alias{listFiles} 11 | \alias{listFiles.default} 12 | \alias{removeAllFiles} 13 | \alias{removeAllFiles.default} 14 | \alias{removeFile} 15 | \alias{removeFile.default} 16 | \alias{rsync} 17 | \alias{sendAllFiles} 18 | \alias{sendAllFiles.default} 19 | \alias{sendFile} 20 | \alias{sendFile.default} 21 | \alias{sendObject} 22 | \alias{sendObject.default} 23 | \alias{syncAllFiles} 24 | \alias{syncAllFiles.default} 25 | \title{\code{removeFile} Remove a file from \code{dest}.} 26 | \usage{ 27 | getData(db, ...) 28 | 29 | \method{getData}{default}(db, fileName, verbose = FALSE, ...) 30 | 31 | getFile(db, ...) 32 | 33 | \method{getFile}{default}(db, fileName, validate = FALSE, verbose = FALSE, ...) 34 | 35 | listFiles(db, ...) 36 | 37 | \method{listFiles}{default}(db, ...) 38 | 39 | removeAllFiles(db, ...) 40 | 41 | \method{removeAllFiles}{default}(db, verbose = FALSE, ...) 42 | 43 | removeFile(db, ...) 44 | 45 | \method{removeFile}{default}(db, fileName, verbose = FALSE, ...) 46 | 47 | rsync(dest, src = getwd(), password = NULL, ssh = NULL, sshProg = NULL) 48 | 49 | sendAllFiles(db, ...) 50 | 51 | \method{sendAllFiles}{default}(db, ...) 52 | 53 | sendFile(db, ...) 54 | 55 | \method{sendFile}{default}(db, fileName, validate = FALSE, verbose = FALSE, ...) 56 | 57 | sendObject(db, ...) 58 | 59 | \method{sendObject}{default}( 60 | db, 61 | object, 62 | objectName = as.character(substitute(object)), 63 | validate = FALSE, 64 | verbose = FALSE, 65 | ... 66 | ) 67 | 68 | syncAllFiles(db, ...) 69 | 70 | \method{syncAllFiles}{default}(db, verbose = FALSE, ...) 71 | } 72 | \arguments{ 73 | \item{db}{(rsync) an object of class 'rsync' initialized with \code{rsync}.} 74 | 75 | \item{...}{arguments passed to methods.} 76 | 77 | \item{fileName}{(character) a file name that exists in \code{src}} 78 | 79 | \item{verbose}{(logical) if we use 'vorbose' as option in the cli.} 80 | 81 | \item{validate}{(logical) if the file in dest and src should be validated 82 | using a sha256 check sum.} 83 | 84 | \item{dest}{(character) the address to the rsync daemon or a folder.} 85 | 86 | \item{src}{(character) a folder.} 87 | 88 | \item{password}{(character|NULL) a password or file name in case a rsync 89 | daemon is used.} 90 | 91 | \item{ssh}{(character|NULL) argument is passed as '-e' option on the command 92 | line. Can be used to further specify ssh settings.} 93 | 94 | \item{sshProg}{(character|NULL) arguments sets the environment variable 95 | 'RSYNC_CONNECT_PROG' during the call. Can be used to setup a ssh connection 96 | to a remote rsync daemon.} 97 | 98 | \item{object}{(ANY) any R object you wish to store.} 99 | 100 | \item{objectName}{(character) the name used to store the object. The file 101 | extension will always be a 'Rdata'.} 102 | } 103 | \description{ 104 | Setup a rsync configuration. The configuration object can be used for access 105 | to a folder. 106 | } 107 | \details{ 108 | \code{getData}: sync and load the contents of a file in \code{dest}. This 109 | can be a Rdata file or a csv or json. The file will be saved in \code{src}. 110 | 111 | \code{getFile} downloads a file from dest and saves it in src. 112 | 113 | \code{removeAllFiles} remove all entries from \code{dest}. \code{src} will 114 | not be affected. 115 | 116 | \code{rsync} is a command line tool. For details see 117 | \url{https://rsync.samba.org/}. From the documentation: 118 | 119 | \emph{There are two different ways for rsync to contact a remote system: 120 | using a remote-shell program as the transport (such as ssh or rsh) or 121 | contacting an rsync daemon directly via TCP. The remote-shell transport is 122 | used whenever the source or destination path contains a single colon (:) 123 | separator after a host specification. Contacting an rsync daemon directly 124 | happens when the source or destination path contains a double colon (::) 125 | separator after a host specification, OR when an rsync:// URL is specified 126 | (see also the "USING RSYNC-DAEMON FEATURES VIA A REMOTE-SHELL CONNECTION" 127 | section for an exception to this latter rule).} 128 | 129 | Currently the rsync interface in this package only allows for remote 130 | locations in the destination. 131 | 132 | \emph{You may also establish a daemon connection using a program as a proxy 133 | by setting the environment variable RSYNC_CONNECT_PROG to the commands 134 | you wish to run in place of making a direct socket connection.} This can be 135 | done using the \code{sshProg} argument. 136 | 137 | \code{sendAllFiles} Sends all files in \code{src} to \code{dest} using \code{sendFile}. 138 | 139 | \code{sendFile} Sends a file to a rsync object. 140 | 141 | \code{sendObject} sends an object (from the environment) 142 | to a rsync target. This abstracts a pattern where you would use \link{save} 143 | followed by \code{sendFile}. The reverse is done using \code{getObject} 144 | 145 | \code{syncAllFiles} Syncs all files in \code{src} to \code{dest}. Files that exist in \code{dest} but not in \code{src} will be deleted. 146 | } 147 | \examples{ 148 | \dontrun{ 149 | ## Please consider examples in the Readme of this project. To get there run: 150 | browseURL("https://github.com/INWTlab/rsync") 151 | 152 | ## Using rsync locally 153 | rsync("~/someFolder") 154 | 155 | ## Examples for remote connections 156 | rsync("rsync://user@host:port/volume", password = "~/my-pwd") 157 | rsync("user@host:~/", ssh = "ssh -i./my-identity-file") 158 | ### requires (netcat) on the host 159 | rsync("user@host::volume", sshProg = "ssh -i./my-identity-file host nc \%H 873") 160 | } 161 | 162 | } 163 | -------------------------------------------------------------------------------- /man/rsynccli.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rsynccli.R 3 | \name{rsynccli} 4 | \alias{rsynccli} 5 | \title{Interface to rsync cli-tool} 6 | \usage{ 7 | rsynccli( 8 | file, 9 | to, 10 | includes = NULL, 11 | excludes = NULL, 12 | args = "-rltvx", 13 | pre = NULL, 14 | intern = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{file}{(character) source.} 19 | 20 | \item{to}{(character) destination.} 21 | 22 | \item{includes, excludes}{(character) with length >=1 or (NULL).} 23 | 24 | \item{args}{(character) arguments passed to rsync. Default is '-rltvx' and 25 | works for most cases.} 26 | 27 | \item{pre}{(character) something that is pasted in front of the 'rsync' 28 | command. E.g. a password.} 29 | 30 | \item{intern}{(logical) passed to \link{system}.} 31 | } 32 | \description{ 33 | Calls the CLI-program 'rsync'. 34 | } 35 | -------------------------------------------------------------------------------- /scratch.R: -------------------------------------------------------------------------------- 1 | library("rsync") 2 | 3 | 4 | knitr::knit("README.Rmd", "README.md") 5 | -------------------------------------------------------------------------------- /tests/daemon-startup.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # This file uses the config inside the container: axiom/rsync-server 3 | 4 | set -e 5 | 6 | USERNAME=${USERNAME:-user} 7 | PASSWORD=${PASSWORD:-pass} 8 | ALLOW=${ALLOW:-127.0.0.1/32} 9 | VOLUME=${VOLUME:-/data} 10 | 11 | if [ "$1" = 'rsync_server' ]; then 12 | 13 | echo "$USERNAME:$PASSWORD" > /etc/rsyncd.secrets 14 | chmod 0400 /etc/rsyncd.secrets 15 | 16 | mkdir -p $VOLUME 17 | 18 | [ -f /etc/rsyncd.conf ] || cat < /etc/rsyncd.conf 19 | pid file = /var/run/rsyncd.pid 20 | log file = /var/log/rsyncd.log 21 | timeout = 300 22 | max connections = 10 23 | port = 873 24 | #reverse lookup = no 25 | 26 | [volume] 27 | uid = root 28 | gid = root 29 | hosts deny = * 30 | hosts allow = ${ALLOW} 31 | read only = false 32 | path = ${VOLUME} 33 | comment = ${VOLUME} directory 34 | auth users = ${USERNAME} 35 | secrets file = /etc/rsyncd.secrets 36 | EOF 37 | 38 | exec /usr/bin/rsync --no-detach --daemon --config /etc/rsyncd.conf "$@" & 39 | fi 40 | -------------------------------------------------------------------------------- /tests/shutdown-remote.sh: -------------------------------------------------------------------------------- 1 | docker stop rsync-server \ 2 | && docker rm rsync-server \ 3 | && docker stop test-sshd \ 4 | && docker rm test-sshd \ 5 | && docker stop test-sshd-rsyncd \ 6 | && docker rm test-sshd-rsyncd \ 7 | && rm docker-root* -v 8 | -------------------------------------------------------------------------------- /tests/startup-remote.sh: -------------------------------------------------------------------------------- 1 | echo "starting rsync server" 2 | docker run \ 3 | --name rsync-server \ 4 | -d \ 5 | -p 8000:873 \ 6 | -e USERNAME=user \ 7 | -e PASSWORD=pass \ 8 | axiom/rsync-server 9 | 10 | echo "starting sshd in container" 11 | docker run \ 12 | -d \ 13 | -p 20011:22 \ 14 | --name test-sshd \ 15 | rastasheep/ubuntu-sshd:18.04 16 | ssh-keygen -f ./docker-root -C "" -N "" 17 | docker cp ./docker-root.pub test-sshd:/root/.ssh/authorized_keys 18 | docker exec test-sshd chown root:root /root/.ssh/authorized_keys 19 | docker exec test-sshd apt-get update 20 | docker exec test-sshd apt-get install -y rsync 21 | 22 | echo "starting sshd and rsyncd in container" 23 | docker run \ 24 | -d \ 25 | -p 20012:22 \ 26 | --name test-sshd-rsyncd \ 27 | rastasheep/ubuntu-sshd:18.04 28 | docker cp ./docker-root.pub test-sshd-rsyncd:/root/.ssh/authorized_keys 29 | docker exec test-sshd-rsyncd chown root:root /root/.ssh/authorized_keys 30 | docker exec test-sshd-rsyncd apt-get update 31 | docker exec test-sshd-rsyncd apt-get install -y rsync netcat 32 | docker cp ./daemon-startup.sh test-sshd-rsyncd:/daemon-startup.sh 33 | docker exec test-sshd-rsyncd bash /daemon-startup.sh rsync_server 34 | 35 | -------------------------------------------------------------------------------- /tests/test-remote.R: -------------------------------------------------------------------------------- 1 | if (identical(Sys.getenv("TRAVIS"), "true")) { 2 | cat("Skip these tests on Travis CI.") 3 | # they take too long and we get a timeout. 4 | q(save = "no") 5 | } 6 | dockerVersion <- try(system("docker --version", intern = TRUE)) 7 | if (inherits(dockerVersion, "try-error") || grepl("docker .* not found", dockerVersion)) { 8 | cat("Docker is not available for testing. Stop here.") 9 | q(save = "no") 10 | } 11 | 12 | withSystemCall <- function(expr) { 13 | system("bash startup-remote.sh") 14 | on.exit(system("bash shutdown-remote.sh")) 15 | expr 16 | } 17 | 18 | checkLength <- function(con, n) { 19 | stopifnot(nrow(rsync::listFiles(con)) == n) 20 | } 21 | 22 | tempFolder <- function() { 23 | tmp <- tempdir() 24 | dir.create(tmp <- paste0(tmp, "/rsync-test"), FALSE) 25 | file.remove(dir(tmp, full.names = TRUE)) 26 | tmp 27 | } 28 | 29 | library("rsync") 30 | withSystemCall({ 31 | ## rsyncd 32 | con <- rsync( 33 | "rsync://user@localhost:8000/volume", 34 | tempFolder(), 35 | password = "pass" 36 | ) 37 | checkLength(rsync::removeAllFiles(con), 0) 38 | x <- 1 39 | checkLength(sendObject(con, x), 1) 40 | y <- 2 41 | checkLength(sendObject(con, y), 2) 42 | checkLength(rsync::removeAllFiles(con), 0) 43 | checkLength(rsync::sendAllFiles(con), 2) 44 | 45 | ## rsyncd password in file 46 | writeLines("pass", ".pass") 47 | con <- rsync( 48 | "rsync://user@localhost:8000/volume", 49 | tempFolder(), 50 | password = ".pass" 51 | ) 52 | checkLength(rsync::removeAllFiles(con), 0) 53 | x <- 1 54 | dat <- listFiles(sendObject(con, x)) 55 | stopifnot(nrow(dat) == 1) 56 | unlink(".pass") 57 | unlink(tempFolder()) 58 | 59 | ## sshd 60 | con <- rsync( 61 | "root@localhost:~", 62 | tempFolder(), 63 | ssh = "ssh -i./docker-root -oStrictHostKeyChecking=no -p20011" 64 | ) 65 | x <- 1 66 | dat <- listFiles(sendObject(con, x)) 67 | stopifnot("x.Rdata" %in% dat$name) 68 | unlink(tempFolder()) 69 | 70 | ## sshd + rsyncd 71 | con <- rsync( 72 | "user@localhost::volume", 73 | password = "pass", 74 | tempFolder(), 75 | sshProg = "ssh -i./docker-root -oStrictHostKeyChecking=no -p20012 -l root localhost nc %H 873" 76 | ) 77 | checkLength(rsync::removeAllFiles(con), 0) 78 | x <- 1 79 | dat <- listFiles(sendObject(con, x)) 80 | stopifnot("x.Rdata" %in% dat$name) 81 | unlink(tempFolder()) 82 | }) 83 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library("rsync") 2 | 3 | if (requireNamespace("testthat", quietly = TRUE)) { 4 | testthat::test_check("rsync") 5 | } 6 | -------------------------------------------------------------------------------- /tests/testthat/helper-setupTestEnvironment.R: -------------------------------------------------------------------------------- 1 | setupTestEnvironment <- function() { 2 | randomName <- function() paste0(sample(letters, 10), collapse = "") 3 | 4 | # setup folder 5 | dirName <- paste0(tempdir(), "/", randomName(), "/") 6 | dirName2 <- paste0(tempdir(), "/", randomName(), "/") 7 | dir.create(dirName) 8 | dir.create(dirName2) 9 | 10 | nestedFolder <- paste0(dirName, "nestedFolder/") 11 | dir.create(nestedFolder) 12 | nestedFolderWithSpace <- paste0(dirName, "nested folder/") 13 | dir.create(nestedFolderWithSpace) 14 | nestedFolderWithTwoSpaces <- paste0(dirName, "nested folder/") 15 | dir.create(nestedFolderWithTwoSpaces) 16 | 17 | # create some files 18 | x <- 1 19 | y <- 2 20 | save(list = "x", file = paste0(dirName, "x.Rdata")) 21 | save(list = "y", file = paste0(dirName, "y.Rdata")) 22 | save(list = "y", file = paste0(nestedFolderWithSpace, "y.Rdata")) 23 | save(list = "x", file = paste0(dirName, ".x.Rdata")) 24 | 25 | rsync( 26 | src = dirName, 27 | dest = dirName2 28 | ) 29 | } 30 | 31 | setupS3TestEnvironment <- function() { 32 | randomName <- function() paste0(sample(letters, 10), collapse = "") 33 | 34 | # setup folder 35 | dirName <- paste0(tempdir(), "/", randomName(), "/") 36 | dir.create(dirName) 37 | nestedFolder <- paste0(dirName, "nestedFolder/") 38 | dir.create(nestedFolder) 39 | folderWithSpace <- paste0(dirName, "nested folder/") 40 | dir.create(folderWithSpace) 41 | folderWithTwoSpaces <- paste0(dirName, "nested folder/") 42 | dir.create(folderWithTwoSpaces) 43 | 44 | # create some files 45 | x <- 1 46 | y <- 2 47 | save(list = "x", file = paste0(dirName, "x.Rdata")) 48 | save(list = "y", file = paste0(dirName, "y.Rdata")) 49 | save(list = "y", file = paste0(dirName, ".y.Rdata")) 50 | save(list = "y", file = paste0(nestedFolder, "y.Rdata")) 51 | save(list = "y", file = paste0(folderWithSpace, "y.Rdata")) 52 | save(list = "y", file = paste0(folderWithTwoSpaces, "y.Rdata")) 53 | 54 | awss3( 55 | src = dirName, 56 | dest = "s3://inwt-testing", 57 | profile = "testing" 58 | ) 59 | } 60 | -------------------------------------------------------------------------------- /tests/testthat/test-as.characet.R: -------------------------------------------------------------------------------- 1 | testthat::context("as.character") 2 | 3 | testthat::test_that("as.character", { 4 | testthat::expect_equal( 5 | as.character(rsync(dest = "rsync://test", src = "/", password = "1234")), 6 | c(dest = "rsync://test", src = "/", password = "****", ssh = "NULL", sshProg = "NULL") 7 | ) 8 | }) 9 | -------------------------------------------------------------------------------- /tests/testthat/test-awss3.R: -------------------------------------------------------------------------------- 1 | testthat::context("awss3") 2 | 3 | testthat::test_that("create data", { 4 | testthat::skip_if(!profileExists("testing")) 5 | con <- setupS3TestEnvironment() 6 | on.exit(try(removeAllFiles(con))) 7 | 8 | invisible(try(removeAllFiles(con))) 9 | invisible(sendAllFiles(con)) 10 | testthat::expect_equal(sum(is.na(listFiles(con)$lastModified)), 3) 11 | testthat::expect_equal(sum(!is.na(listFiles(con)$lastModified)), 3) 12 | testthat::expect_equal(nrow(listFiles(con)), 6) 13 | testthat::expect_equal(getData(con, "x.Rdata"), list(x = 1)) 14 | testthat::expect_equal(getData(con, "nestedFolder/y.Rdata"), list(y = 2)) 15 | testthat::expect_equal(getData(con, "nested folder/y.Rdata"), list(y = 2)) 16 | testthat::expect_equal(getData(con, "nested folder/y.Rdata"), list(y = 2)) 17 | z <- 1 18 | invisible(sendObject(con, z)) 19 | testthat::expect_equal(nrow(listFiles(con)), 7) 20 | testthat::expect_equal(nrow(listFiles(con, recursive = TRUE)), 7) 21 | testthat::expect_equal(sum(!is.na(listFiles(con, recursive = TRUE)$lastModified)), 7) 22 | testthat::expect_equal(nrow(listFiles(removeAllFiles(con))), 0) 23 | 24 | invisible(try(removeAllFiles(con))) 25 | invisible(sendFile(con, "x.Rdata", args = "--dryrun")) 26 | invisible(sendFile(con, "x.Rdata", verbose = TRUE, args = "--dryrun")) 27 | testthat::expect_equal(nrow(listFiles(con)), 0) 28 | }) 29 | -------------------------------------------------------------------------------- /tests/testthat/test-checkForSystemResult.R: -------------------------------------------------------------------------------- 1 | testthat::context("checkSystemResult") 2 | 3 | test_that("checkSystemResult with intern = TRUE and successful command", { 4 | command <- "true" 5 | intern <- TRUE 6 | status <- system(command, intern = intern, wait = TRUE) 7 | result <- checkSystemResult(status) 8 | 9 | expect_is(status, "character") 10 | expect_is(result, "character") 11 | expect_equal(result, status) 12 | }) 13 | 14 | test_that("checkSystemResult with intern = FALSE and successful command", { 15 | command <- "true" 16 | intern <- FALSE 17 | status <- system(command, intern = intern, wait = TRUE) 18 | result <- checkSystemResult(status) 19 | 20 | expect_is(status, "integer") 21 | expect_is(result, "integer") 22 | expect_equal(result, status) 23 | }) 24 | 25 | test_that("checkSystemResult with intern = TRUE and failing command", { 26 | command <- "false" 27 | intern <- TRUE 28 | 29 | expect_warning( 30 | status <- system(command, intern = intern, wait = TRUE) 31 | ) 32 | expect_error(checkSystemResult(status)) 33 | expect_is(status, "character") 34 | expect_equal(attr(status, "status"), 1) 35 | }) 36 | 37 | test_that("checkSystemResult with intern = FALSE and failing command", { 38 | command <- "false" 39 | intern <- FALSE 40 | 41 | status <- system(command, intern = intern, wait = TRUE) 42 | expect_error(checkSystemResult(status)) 43 | expect_is(status, "integer") 44 | expect_equal(status, 1) 45 | }) 46 | -------------------------------------------------------------------------------- /tests/testthat/test-getData.R: -------------------------------------------------------------------------------- 1 | context("getData") 2 | 3 | testthat::test_that("load data", { 4 | 5 | con <- setupTestEnvironment() 6 | 7 | #csv 8 | dat <- data.frame( 9 | x = 1L, 10 | date = "2018-12-24", 11 | z = 1.12345, 12 | stringsAsFactors = FALSE 13 | ) 14 | 15 | data.table::fwrite(dat, file = getSrcFile(con, "dat.csv")) 16 | sendFile(con, "dat.csv") 17 | 18 | #json 19 | lst <- list( 20 | x = 1:3, 21 | date = "2018-12-24" 22 | ) 23 | jsonlite::write_json(lst, path = getSrcFile(con, "lst.json")) 24 | 25 | #Rdata 26 | invisible(removeAllFiles(con)) 27 | invisible(sendFile(con, fileName = 'x.Rdata')) 28 | testthat::expect_true(nrow(listFiles(con)) == 1) 29 | rdata <- getData(con, fileName = 'x.Rdata') 30 | testthat::expect_true(objects(rdata) == "x") 31 | rm(rdata) 32 | testthat::expect_true(file.exists(getDestFile(con,'x.Rdata'))) 33 | 34 | #csv 35 | invisible(removeAllFiles(con)) 36 | invisible(sendFile(con, fileName = 'dat.csv')) 37 | testthat::expect_true(nrow(listFiles(con)) == 1) 38 | csvData <- getData(con, fileName = 'dat.csv') 39 | csvData$date <- as.character(csvData$date) 40 | testthat::expect_true(identical(dat, csvData)) 41 | 42 | #json 43 | invisible(removeAllFiles(con)) 44 | invisible(sendFile(con, fileName = 'lst.json')) 45 | testthat::expect_true(nrow(listFiles(con)) == 1) 46 | jsonData <- getData(con, fileName = 'lst.json') 47 | testthat::expect_true(identical(jsonData, lst)) 48 | 49 | }) 50 | 51 | -------------------------------------------------------------------------------- /tests/testthat/test-getFile.R: -------------------------------------------------------------------------------- 1 | context("getFile") 2 | 3 | testthat::test_that("get files", { 4 | con <- setupTestEnvironment() 5 | 6 | testthat::expect_true(nrow(listFiles(removeAllFiles(con))) == 0) 7 | sendFile(con, fileName = "x.Rdata") 8 | testthat::expect_true(nrow(listFiles(con)) == 1) 9 | testthat::expect_true(file.remove(getSrcFile(con, "x.Rdata"))) 10 | getFile(con, fileName = "x.Rdata") 11 | testthat::expect_true(file.exists(getSrcFile(con, "x.Rdata"))) 12 | 13 | invisible(sendAllFiles(con)) 14 | getFile(con, fileName = "nested folder/y.Rdata") 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-listFiles.R: -------------------------------------------------------------------------------- 1 | context("listFiles") 2 | 3 | test_that("list entries in dest", { 4 | con <- setupTestEnvironment() 5 | 6 | invisible(removeAllFiles(con)) 7 | invisible(sendFile(con, fileName = "x.Rdata")) 8 | invisible(sendFile(con, fileName = "y.Rdata")) 9 | testthat::expect_true(nrow(listFiles(con)) == 2) 10 | invisible(removeAllFiles(con)) 11 | testthat::expect_true(nrow(listFiles(con)) == 0) 12 | 13 | testthat::expect_output(dat <- print(con)) 14 | testthat::expect_identical(dat, con) 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-removeAllFiles.R: -------------------------------------------------------------------------------- 1 | context("removeAllFiles") 2 | 3 | test_that("remove all files", { 4 | 5 | con <- setupTestEnvironment() 6 | 7 | invisible(sendFile(con, fileName = 'x.Rdata')) 8 | invisible(sendFile(con, fileName = 'y.Rdata')) 9 | testthat::expect_true(!is.null(listFiles(con))) 10 | invisible(removeAllFiles(con)) 11 | testthat::expect_true(nrow(listFiles(con)) == 0) 12 | 13 | }) 14 | 15 | 16 | -------------------------------------------------------------------------------- /tests/testthat/test-removeFile.R: -------------------------------------------------------------------------------- 1 | context("removeFile") 2 | 3 | testthat::test_that("Removing files", { 4 | 5 | con <- setupTestEnvironment() 6 | 7 | #rsyncD 8 | invisible(removeAllFiles(con)) 9 | testthat::expect_true(nrow(listFiles(con)) == 0) 10 | invisible(sendFile(con, fileName = 'y.Rdata')) 11 | testthat::expect_true(nrow(listFiles(con)) == 1) 12 | invisible(removeFile(con, fileName = 'y.Rdata')) 13 | testthat::expect_true(nrow(listFiles(con)) == 0) 14 | 15 | }) 16 | 17 | -------------------------------------------------------------------------------- /tests/testthat/test-sendAllFiles.R: -------------------------------------------------------------------------------- 1 | context("sendAllFiles") 2 | 3 | test_that("send all files", { 4 | con <- setupTestEnvironment() 5 | 6 | invisible(removeAllFiles(con)) 7 | 8 | sendAllFiles(con) 9 | testthat::expect_true(nrow(listFiles(con)) == 6) 10 | }) 11 | -------------------------------------------------------------------------------- /tests/testthat/test-sendFile.R: -------------------------------------------------------------------------------- 1 | context("sendFile") 2 | 3 | test_that("send file", { 4 | con <- setupTestEnvironment() 5 | 6 | withCleanDest <- function(expr) { 7 | invisible(removeAllFiles(con)) 8 | on.exit({ 9 | invisible(removeAllFiles(con)) 10 | }) 11 | expr 12 | } 13 | 14 | withCleanDest({ 15 | sendFile(con, "x.Rdata") 16 | testthat::expect_true(nrow(listFiles(con)) == 1) 17 | }) 18 | 19 | withCleanDest({ 20 | sendFile(con, ".x.Rdata") 21 | testthat::expect_true(nrow(listFiles(con)) == 1) 22 | }) 23 | 24 | withCleanDest({ 25 | testthat::expect_error(sendFile(con, "__aa__.Rdata"), "file.exists") 26 | testthat::expect_true(nrow(listFiles(con)) == 0) 27 | }) 28 | }) 29 | -------------------------------------------------------------------------------- /tests/testthat/test-sendObject.R: -------------------------------------------------------------------------------- 1 | context("sendObject") 2 | 3 | test_that("sending Objects for rsyncL is working", { 4 | con <- setupTestEnvironment() 5 | invisible(removeAllFiles(con)) 6 | z <- 1 7 | sendObject(db = con, object = z, validate = TRUE) 8 | testthat::expect_true(nrow(listFiles(con)) == 1) 9 | invisible(removeAllFiles(db = con)) 10 | }) 11 | -------------------------------------------------------------------------------- /tests/testthat/test-syncAllFiles.R: -------------------------------------------------------------------------------- 1 | context("syncAllFiles") 2 | 3 | test_that("sync all files (with delete)", { 4 | con <- setupTestEnvironment() 5 | 6 | invisible(removeAllFiles(con)) 7 | ## add extra files and folders into destination 8 | cat("blah", file = file.path(getDest(con), "extra_file.txt")) 9 | cat("blah", file = file.path(getDest(con), ".dotfile")) 10 | cat("blah", file = file.path(getDest(con), "filenodot")) 11 | dir.create(tempfile(tmpdir = getDest(con))) 12 | 13 | ## send, with no delete 14 | sendAllFiles(con) 15 | testthat::expect_true(nrow(listFiles(con)) == 10) 16 | 17 | ## now with delete 18 | syncAllFiles(con) 19 | testthat::expect_true(nrow(listFiles(con)) == 6) 20 | }) 21 | 22 | test_that("sync all files (with delete) on AWS S3", { 23 | testthat::skip_if(!profileExists("testing")) 24 | removeFileFromSrc <- function(con, file) { 25 | file <- paste0(getSrc(con), file) 26 | unlink(file, recursive = TRUE) 27 | } 28 | con <- setupS3TestEnvironment() 29 | invisible(removeAllFiles(con)) 30 | 31 | ## send, with no delete 32 | sendAllFiles(con) 33 | testthat::expect_true(nrow(listFiles(con)) == 6) 34 | 35 | ## remove some files and sync 36 | removeFileFromSrc(con, "nested folder") 37 | removeFileFromSrc(con, ".y.Rdata") 38 | removeFileFromSrc(con, "y.Rdata") 39 | syncAllFiles(con) 40 | testthat::expect_true(nrow(listFiles(con)) == 3) 41 | }) 42 | -------------------------------------------------------------------------------- /tests/testthat/test-validateFile.R: -------------------------------------------------------------------------------- 1 | context("validateFile") 2 | 3 | testthat::test_that("validate identical entries", { 4 | 5 | con <- setupTestEnvironment() 6 | existingTempDirectories <- list.files(tempdir(), pattern = "[[:alpha:]]{8}") 7 | 8 | removeAllFiles(con) 9 | sendFile(con, fileName = 'x.Rdata') 10 | testthat::expect_true(nrow(listFiles(con)) == 1) 11 | testthat::expect_message(testthat::expect_true( 12 | validateFile(con, fileName = 'x.Rdata'))) 13 | 14 | con1 <- con 15 | con1$src <- paste0(tempdir(), "/") 16 | x <- 1234 17 | sendObject(con1, x) 18 | testthat::expect_warning( 19 | validateFile(con, fileName = "x.Rdata"), 20 | "Src and dest file are not identical!" 21 | ) 22 | 23 | # This test needs at least some documentation. We encountered an issue with already existing 24 | # directoris when running dir.create(db1$src) in validateFile. So, we are calling unlink in the 25 | # exit code of validateFile. To ensure that the directory has been removed, we would usually call 26 | # dir.exists but we don't know the path name as the directory was created inside of validateFile. 27 | # So, we store all the directories inside of tempdir before we call validateFile and do the same 28 | # at the end of the test. If the directory was actually unlinked, we expect the set of 29 | # directories inside tempdir to remain unchanged. 30 | testthat::expect_identical( 31 | existingTempDirectories, 32 | list.files(tempdir(), pattern = "[[:alpha:]]{8}") 33 | ) 34 | }) 35 | 36 | --------------------------------------------------------------------------------