Redirect 413

.github/workflows/r-cmd-check.yml

@@ -35,7 +35,6 @@ jobs:
           - {os: ubuntu-latest,  r: 'release'}
           - {os: ubuntu-latest,  r: 'oldrel-1'}
           - {os: ubuntu-latest,  r: 'oldrel-2'}
-          - {os: ubuntu-latest,  r: 'oldrel-3'}
 
     env:
       R_KEEP_PKG_SOURCE: yes

R/curl.R

@@ -25,7 +25,8 @@
     fields     = cfg$fields,
     options    = modifyList(list(timeout_ms = 3e5,
                                  useragent  = .curlDefaultUa(),
-                                 post       = TRUE),
+                                 post       = TRUE,
+                                 followlocation = FALSE),
                             cfg$options),
     auth_token = token,
     output     = structure(list(), class = c("write_memory", "write_function"))

R/makeApiCall.R

@@ -12,6 +12,7 @@
 #' @param url `character(1)` A url string to hit. Defaults to rcon$url.
 #' @param success_status_codes `integerish` A vector of success codes to ignore
 #'   for error handling. Defaults to c(200L).
+#' @param redirect `logical(1)` Is redirection on the request allowed?
 #' @param ... This will capture `api_param` (if specified) which will modify the body of the 
 #'   the specified body of the request. It also captures `config` which will get
 #'   passed to curl::handle_setopt.
@@ -142,6 +143,7 @@ makeApiCall <- function(rcon,
                         body   = list(), 
                         url    = NULL,
                         success_status_codes = 200L,
+                        redirect = TRUE,
                         ...)
 {
   # Pull config, api_param from ...
@@ -176,6 +178,10 @@ makeApiCall <- function(rcon,
   checkmate::assert_list(x = api_param, 
                          names = "named", 
                          add = coll)
+
+  checkmate::assert_logical(x   = redirect,
+                            len = 1,
+                            add = coll)
 
   checkmate::reportAssertions(coll)
 
@@ -221,7 +227,7 @@ makeApiCall <- function(rcon,
       message(paste0(">>>\n", as.character(response), "<<<\n"))
     }
 
-    response <- .makeApiCall_handleRedirect(rcon, body, response, ...)
+    if(redirect) response <- .makeApiCall_handleRedirect(rcon, body, response, ...)
 
     is_retry_eligible <- .makeApiCall_isRetryEligible(response)
 
@@ -262,7 +268,7 @@ makeApiCall <- function(rcon,
     }
 
     # Good for a single call
-    makeApiCall(rcon, body, response$headers$location, ...)
+    makeApiCall(rcon, body, response$header$location, ...)
   } else 
     response # The not redirected case
 }

R/unlockREDCap.R

@@ -42,8 +42,10 @@ connectAndCheck <- function(key, url, ...)
       rcon    <- redcapConnection(token=key, url=url, ...)
       version <- list(content = "version", format = "csv")
       # Test connection by checking version
-      response <- makeApiCall(rcon, body = version,
-        success_status_codes=c(200L, 301L, 302L)
+      response <- makeApiCall(rcon,
+        body = version,
+        success_status_codes=c(200L, 301L, 302L),
+        redirect=FALSE
       )
 
       # No redirect, this is success
@@ -52,17 +54,16 @@ connectAndCheck <- function(key, url, ...)
       # Handle redirect
       rcon <- redcapConnection(
         token = key,
-        url   = paste0(response$header$location, '/api/'),
+        url   = response$header$location,
         ...)
 
       # Test connection by checking version post redirect
       response <- makeApiCall(rcon, body = version,
-        success_status_codes=c(200L, 301L, 302L))
+        success_status_codes=c(200L, 301L, 302L), redirect=FALSE)
 
       if(response$status_code %in% c(301L, 302L))
         stop(paste("Too many redirects from", url))
 
-
       rcon
     },
     error = function(e)

tests/testthat/test-024-unlockREDCap.R

@@ -13,7 +13,7 @@ redirect <- structure(
        content = "",
        headers=structure(list(
          'content-type'="text/csv; charset=utf-8",
-         'location'=gsub('\\/api\\/', '', url)
+         'location'=url
        ),
        class = c("insensitive", "list")),
   class = "response")

tests/testthat/test-050-makeApiCall.R

@@ -22,6 +22,24 @@ test_that(
   }
 )
 
+test_that(
+  "makeApiCall will not allow a non-logical redirect parameter",
+  {
+    expect_error(
+      makeApiCall(rcon,  body = list(format = "csv"), url='xyz.com', redirect=23),
+      "redirect.*Must be of type 'logical'")
+  }
+)
+
+test_that(
+  "makeApiCall will not allow more than one redirect parameter",
+  {
+    expect_error(
+      makeApiCall(rcon,  body = list(format = "csv"), url='xyz.com', redirect=c(TRUE, TRUE)),
+      "redirect.*Must have length 1")
+  }
+)
+
 test_that(
   ".makeApiCall_isRetryEligible returns appropriate logical values", 
   {