Add support for custom S3 endpoints (e.g., Hetzner)

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rsync
 Type: Package
 Title: API to use rsync
-Version: 24.10.0
+Version: 25.10.0
 Author: INWT Statistics GmbH
 Authors@R: c(person("Sebastian", "Warnholz", email = "[email protected]", role = c("aut", "cre")),
              person("Jonathan", "Bob", email = "[email protected]", role = c("aut")),
@@ -24,4 +24,4 @@ Suggests:
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2

NEWS.md

@@ -0,0 +1,4 @@
+# rsync 25.10.0
+
+## Added
+- Added support for custom S3 endpoints (e.g., Hetzner)

R/awscli.R

@@ -1,4 +1,4 @@
-awscli <- function(src, dest, includes = NULL, excludes = NULL, args = "", profile = NULL, intern = FALSE) {
+awscli <- function(src, dest, includes = NULL, excludes = NULL, args = "", profile = NULL, endpoint_url = NULL, intern = FALSE) {
   constructArg <- function(x, s) {
     if (is.null(x)) {
       return(x)
@@ -9,6 +9,7 @@ awscli <- function(src, dest, includes = NULL, excludes = NULL, args = "", profi
   includes <- constructArg(includes, "--include")
   excludes <- constructArg(excludes, "--exclude")
   profile <- if (is.null(profile)) "" else paste("--profile", profile)
+  endpoint <- if (is.null(endpoint_url)) "" else paste("--endpoint-url", endpoint_url)
   dest <- paste("\"", dest, "\"", sep = "")
   src <- if (!is.null(src)) paste("\"", src, "\"", sep = "") else NULL
 
@@ -18,6 +19,7 @@ awscli <- function(src, dest, includes = NULL, excludes = NULL, args = "", profi
     excludes,
     includes,
     profile,
+    endpoint,
     src,
     dest
   )

R/awss3.R

@@ -10,6 +10,8 @@
 #'   a profile. In case of a list a new profile will be created which is
 #'   persistent. A profile is created using \code{aws configure} and stores
 #'   credentials for the user in plain text.
+#' @param endpoint_url (NULL|character) The endpoint URL for S3-compatible providers like
+#'   Hetzner. E.g. 'https://fsn1.your-objectstorage.com'.
 #' @param force (logical) override profile if it exists.
 #' @param db (awss3) connection created with \code{awss3}
 #' @param fileName (character) a file name in dest/src
@@ -32,13 +34,14 @@
 #'
 #' @rdname awss3
 #' @export
-awss3 <- function(dest, src = getwd(), profile = NULL) {
+awss3 <- function(dest, src = getwd(), profile = NULL, endpoint_url = NULL) {
   stopifnot(
     is.character(dest) && length(dest) == 1,
     is.character(src) && length(src) == 1,
     is.null(profile) ||
       (is.character(profile) && length(profile) == 1 && profileExists(profile)) ||
-      (is.list(profile) && is.character(profile$name))
+      (is.list(profile) && is.character(profile$name)),
+    is.null(endpoint_url) || is.character(endpoint_url) && length(endpoint_url) == 1
   )
   src <- if (isS3Bucket(src)) {
     sub("/$", "", src)
@@ -57,7 +60,8 @@ awss3 <- function(dest, src = getwd(), profile = NULL) {
   ret <- list(
     dest = dest,
     src = src,
-    profile = profile
+    profile = profile,
+    endpoint_url = endpoint_url
   )
   class(ret) <- "awss3"
   ret

R/getFile.R

@@ -10,7 +10,6 @@ getFile <- function(db, ...) {
 #' @rdname rsync
 #' @export
 getFile.default <- function(db, fileName, validate = FALSE, verbose = FALSE, ...) {
-
   args <- if (verbose == TRUE) "-ltrvvx" else "-ltrx"
   args <- paste(args, getArgs(db))
 
@@ -28,15 +27,15 @@ getFile.default <- function(db, fileName, validate = FALSE, verbose = FALSE, ...
 #' @rdname awss3
 #' @export
 getFile.awss3 <- function(db, fileName, validate = FALSE, verbose = FALSE, ...) {
-
   args <- if (!verbose) "--quiet --no-progress --only-show-errors" else ""
   args <- paste("sync ", args)
 
   dest <- getDest(db)
   src <- getSrc(db)
   profile <- getProfile(db)
+  endpoint_url <- db$endpoint_url
 
-  awscli(dest, src, args = args, excludes = "*", includes = fileName, profile = profile)
+  awscli(dest, src, args = args, excludes = "*", includes = fileName, profile = profile, endpoint_url = endpoint_url)
 
   if (validate) validateFile(db, fileName)
 

R/listFiles.R

@@ -57,11 +57,12 @@ emptyDir <- function() {
 listFiles.awss3 <- function(db, recursive = FALSE, ...) {
   dest <- getDest(db)
   profile <- getProfile(db)
+  endpoint_url <- db$endpoint_url
   if (!isS3Bucket(dest)) {
     return(NextMethod())
   }
   args <- if (recursive) "ls --recursive" else "ls"
-  dir <- awscli(NULL, dest, args = args, profile = profile, intern = TRUE)
+  dir <- awscli(NULL, dest, args = args, profile = profile, endpoint_url = endpoint_url, intern = TRUE)
   dir <- dat::extract(dir, ~ !grepl("\\.$", .))
   if (length(dir) == 0) {
     return(emptyDir())

R/removeFile.R

@@ -38,13 +38,14 @@ removeFile.awss3 <- function(db, fileName, verbose = FALSE, ...) {
 
   dest <- getDest(db)
   profile <- getProfile(db)
+  endpoint_url <- db$endpoint_url
   if (!isS3Bucket(dest)) {
     return(NextMethod())
   }
 
   args <- if (!verbose) "--quiet --only-show-errors --recursive" else "--recursive"
   args <- paste("rm", args)
 
-  awscli(NULL, dest, includes = fileName, excludes = "*", args = args, profile = profile)
+  awscli(NULL, dest, includes = fileName, excludes = "*", args = args, profile = profile, endpoint_url = endpoint_url)
   db
 }

R/sendAllFiles.R

@@ -22,7 +22,8 @@ sendAllFiles.awss3 <- function(db, verbose = FALSE, ...) {
   src <- getSrc(db)
   dest <- getDest(db)
   profile <- getProfile(db)
+  endpoint_url <- db$endpoint_url
 
-  awscli(src, dest, args = args, profile = profile)
+  awscli(src, dest, args = args, profile = profile, endpoint_url = endpoint_url)
   db
 }

R/sendFile.R

@@ -35,8 +35,9 @@ sendFile.awss3 <- function(db, fileName, validate = FALSE, verbose = FALSE, args
   src <- getSrc(db)
   dest <- getDest(db)
   profile <- getProfile(db)
+  endpoint_url <- db$endpoint_url
 
-  awscli(src, dest, args = args, excludes = "*", includes = fileName, profile = profile)
+  awscli(src, dest, args = args, excludes = "*", includes = fileName, profile = profile, endpoint_url = endpoint_url)
 
   if (validate) validateFile(db, fileName)
   db

R/syncAllFiles.R

@@ -10,7 +10,6 @@ syncAllFiles <- function(db, ...) {
 #' @rdname rsync
 #' @export
 syncAllFiles.default <- function(db, verbose = FALSE, ...) {
-
   args <- if (verbose) "-ltrvvx" else "-ltrx"
   args <- paste(args, "--delete")
 
@@ -25,15 +24,14 @@ syncAllFiles.default <- function(db, verbose = FALSE, ...) {
 #' @rdname awss3
 #' @export
 syncAllFiles.awss3 <- function(db, verbose = FALSE, ...) {
-
   args <- if (!verbose) "--quiet --no-progress --only-show-errors" else ""
   args <- paste("sync", args, "--delete")
 
   src <- getSrc(db)
   dest <- getDest(db)
   profile <- getProfile(db)
+  endpoint_url <- db$endpoint_url
 
-  awscli(src, dest, args = args, profile = profile)
+  awscli(src, dest, args = args, profile = profile, endpoint_url = endpoint_url)
   db
-
 }