Keyring 417

.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

.gitlab-ci.yml

@@ -10,5 +10,5 @@ test:
     - cp $KEYRING tests/testthat.yml
     - apt-get update
     - apt-get install -y libsecret-1-dev libsodium-dev
-    - R --no-save -e "install.packages(c('devtools','checkmate','chron','curl','labelVector','lubridate','keyring','getPass','yaml','Hmisc','mockery','mime','jsonlite'))"
+    - R --no-save -e "install.packages(c('devtools','checkmate','chron','curl','labelVector','lubridate','keyring','getPass','yaml','Hmisc','mockery','mime','jsonlite','shelter'))"
     - R --no-save -e "Sys.setenv(CI=1); devtools::test(stop_on_failure=TRUE)"

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: redcapAPI
 Type: Package
 Title: Interface to 'REDCap'
-Version: 2.10.1
+Version: 2.11.0
 Authors@R: c(
     person("Benjamin", "Nutter", email = "[email protected]", 
            role = c("ctb", "aut")),
@@ -46,11 +46,9 @@ Imports:
     labelVector,
     lubridate,
     mime,
-    keyring,
-    getPass,
-    yaml
+    shelter
 LazyLoad: yes
-Suggests: testthat (>= 3.0.0), Hmisc, rstudioapi, mockery
+Suggests: testthat (>= 3.0.0), Hmisc, mockery
 URL: https://github.com/vubiostat/redcapAPI
 BugReports: https://github.com/vubiostat/redcapAPI/issues
 Encoding: UTF-8

NAMESPACE

@@ -229,20 +229,13 @@ importFrom(curl,handle_setheaders)
 importFrom(curl,handle_setopt)
 importFrom(curl,new_handle)
 importFrom(curl,parse_headers_list)
-importFrom(getPass,getPass)
 importFrom(jsonlite,fromJSON)
-importFrom(keyring,key_delete)
-importFrom(keyring,key_get)
-importFrom(keyring,key_list)
-importFrom(keyring,key_set_with_value)
-importFrom(keyring,keyring_create)
-importFrom(keyring,keyring_list)
-importFrom(keyring,keyring_unlock)
 importFrom(labelVector,get_label)
 importFrom(labelVector,is.labelled)
 importFrom(labelVector,set_label)
 importFrom(lubridate,parse_date_time)
 importFrom(mime,guess_type)
+importFrom(shelter,unlockKeys)
 importFrom(stats,reshape)
 importFrom(utils,capture.output)
 importFrom(utils,compareVersion)
@@ -254,4 +247,3 @@ importFrom(utils,read.csv)
 importFrom(utils,tail)
 importFrom(utils,write.csv)
 importFrom(utils,write.table)
-importFrom(yaml,read_yaml)

NEWS

@@ -10,6 +10,11 @@ A future release of version 3.0.0 will introduce several breaking changes!
 * The `exportProjectInfo` and `exportBundle` functions are being discontinued. Their functionality is replaced by caching values on the connection object.
 * The `cleanseMetaData` function is being discontinued.
 
+## 2.11.0
+
+* `unlockREDCap` internal code is now in package `shelter`. 
+* This is a breaking change as all existing local keyrings must be reseeded.
+
 ## 2.10.1
 
 * `unlockREDCap` no longer changes console focus

R/redcapAPI-package.R

@@ -18,17 +18,14 @@
 #' @keywords internal
 #' @import checkmate
 #' @importFrom chron times
-#' @importFrom getPass getPass
 #' @importFrom curl curl_fetch_memory curl_version form_file handle_cookies handle_reset
 #' handle_setform handle_setheaders handle_setopt new_handle parse_headers_list
 #' @importFrom jsonlite fromJSON
-#' @importFrom keyring key_delete key_get key_list key_set_with_value keyring_create keyring_list keyring_unlock
 #' @importFrom labelVector get_label is.labelled set_label
 #' @importFrom lubridate parse_date_time
 #' @importFrom mime guess_type
 #' @importFrom stats reshape
 #' @importFrom utils capture.output compareVersion head modifyList
 #' osVersion packageVersion read.csv tail write.csv write.table
-#' @importFrom yaml read_yaml
 
 "_PACKAGE"

R/redcapConnection.R

@@ -173,7 +173,8 @@ redcapConnection <- function(url = getOption('redcap_api_url'),
                              config = NULL,
                              retries = 5, 
                              retry_interval = 2^(seq_len(retries)), 
-                             retry_quietly = TRUE)
+                             retry_quietly = TRUE,
+                             ...)
 {
   coll <- checkmate::makeAssertCollection()
 

R/unlockREDCap.R

@@ -81,153 +81,6 @@ connectAndCheck <- function(key, url, ...)
   )
 }
 
-.savePWGlobalEnv <- function(password)
-{
-  Sys.setenv(REDCAPAPI_PW=password)
-
-  # Hacked work around for RStudio starting new session for everything
-  if(requireNamespace("rstudioapi", quietly = TRUE) &&
-     rstudioapi::isAvailable(child_ok=TRUE))
-    rstudioapi::sendToConsole(sprintf("Sys.setenv(REDCAPAPI_PW='%s')", password), execute = TRUE, echo=FALSE, focus=FALSE)
-}
-
-.clearPWGlobalEnv <- function()
-{
-  Sys.unsetenv("REDCAPAPI_PW")
-  # Hacked work around for RStudio starting new session for everything
-  if(requireNamespace("rstudioapi", quietly = TRUE) &&
-     rstudioapi::isAvailable(child_ok=TRUE))
-    rstudioapi::sendToConsole('Sys.unsetenv("REDCAPAPI_PW")', execute = TRUE, echo=FALSE, focus=FALSE)
-}
-
-.getPWGlobalEnv <- function()
-{
-  Sys.getenv("REDCAPAPI_PW")
-}
-
-  #############################################################################
- ## unlock via YAML override if it exists
-##
-.unlockYamlOverride <- function(connections, url, ...)
-{
-  config_file <- file.path("..", paste0(basename(getwd()),".yml"))
-
-  if(!file.exists(config_file)) return(list())
-
-  config <- yaml::read_yaml(config_file)
-  if(is.null(config$redcapAPI)) stop(paste0("Config file '",config_file,"' does not contain required 'redcapAPI' entry"))
-  config <- config$redcapAPI
-  if(is.null(config$keys))      stop(paste0("Config file '",config_file,"' does not contain required 'keys' entry under the 'redcapAPI' entry"))
-  keys   <- config$keys
-
-  dest <- lapply(connections, function(conn) 
-  {
-    key  <- keys[[conn]]
-
-    if(is.null(key) || length(key)==0)
-      stop(paste0("Config file '", config_file, "' does not have API_KEY for '", conn,"' under 'redcapAPI: keys:' specified."))
-    if(!is.character(key))
-    {
-      stop(paste0("Config file '", config_file, "' invalid entry for '", conn,"' under 'redcapAPI: keys:'."))
-    }
-    if(length(key) > 1)
-      stop(paste0("Config file '", config_file, "' has too may key entries for '", conn,"' under 'redcapAPI: keys:' specified."))
-
-    args     <- list(...)
-    args$key <- key
-    args$url <- url
-    if(!is.null(config$args)) args <- utils::modifyList(args, config$args)
-    do.call(connectAndCheck, args)
-  })
-  names(dest) <- if(is.null(names(connections))) connections else names(connections)
-
-  return(dest)
-}
-  #############################################################################
- ## unlock via ENV override if it exists
-##
-.unlockENVOverride <- function(connections, url, ...)
-{
-  api_key_ENV <- sapply(connections, function(x) Sys.getenv(toupper(x)))
-
-  if(all(api_key_ENV == "")) return(list())
-
-  if(any(api_key_ENV == ""))
-    stop(paste("Some matching ENV variables found but missing:",paste0(toupper(connections[api_key_ENV=='']), collapse=", ")))
-
-  dest <- lapply(api_key_ENV, function(conn) 
-  {
-    args     <- list(...)
-    args$key <- conn
-    args$url <- url
-    do.call(connectAndCheck, args)
-  })
-  names(dest) <- if(is.null(names(api_key_ENV))) api_key_ENV else names(api_key_ENV)
-
-  return(dest)
-}
-
-  #############################################################################
- ## unlock keyring
-##
-.unlockKeyring <- function(keyring, passwordFUN)
-{
-  state <- keyring::keyring_list()
-  state <- state[state$keyring==keyring,]
-  msg   <- paste0("Please enter password to unlock API keyring '",keyring, "'.")
-
-  # If so, does it exist?
-  if(nrow(state) == 1) # Exists => UNLOCK
-  {
-    locked <- state$locked
-    # Is it locked
-    while(locked)
-    {
-      password <- .getPWGlobalEnv()
-      stored   <- !is.null(password) && password != ''
-      if(!stored) password <- passwordFUN(msg)
-      if(is.null(password) || password == '') stop(paste0("User aborted keyring '",keyring, "' unlock."))
-
-      tryCatch(
-        {
-          keyring::keyring_unlock(keyring, password)
-          .savePWGlobalEnv(password)
-          locked <- FALSE
-        },
-        error = function(e)
-        {
-          if(stored) .clearPWGlobalEnv()
-
-          msg <<-  paste0("Provided password failed. Please enter password to unlock API keyring '",keyring, "'.")
-        }
-      )
-    }
-  } else # Keyring does not exist => Create
-  {
-    password <- passwordFUN(paste0("Creating keyring. Enter NEW password for the keyring '",
-                                   keyring, "'."))
-    if(is.null(password) || password == '') stop(paste0("User cancelled creation of keyring '", keyring, "'."))
-
-    keyring::keyring_create(keyring, password)
-    .savePWGlobalEnv(password)
-  }
-}
-
-  #############################################################################
- ## Find the best password function
-## If rstudioapi is loaded and rstudio is running, then use that.
-## getOption('askpass') returns a function that does not work on MAC 
-## when knitting from RStudio, ugh.
-.default_pass <- function()
-{
-  if(isTRUE(grepl('mac', tolower(utils::osVersion))) &&
-     requireNamespace("rstudioapi", quietly = TRUE)  &&
-     rstudioapi::isAvailable(child_ok=TRUE))
-  {
-    rstudioapi::askForPassword
-  } else getPass::getPass
-}
-
 #' Open REDCap connections using cryptolocker for storage of API_KEYs.
 #'
 #' Opens a set of connections to REDcap from API_KEYs stored in an encrypted keyring.
@@ -278,9 +131,8 @@ connectAndCheck <- function(key, url, ...)
 #'          which returns the keys as a list. Use [globalenv()] to assign in the
 #'          global environment. Will accept a number such a '1' for global as well.
 #' @param keyring character. Potential keyring, not used by default.
+#' @param service character. The name to use in a yaml file for locating keys.
 #' @param url character. The url of one's institutional REDCap server api. 
-#' @param passwordFUN function. Function to get the password for the keyring. Usually defaults `getPass::getPass`. 
-#'          On MacOS it will use rstudioapi::askForPassword if available. 
 #' @param \dots Additional arguments passed to [redcapConnection()].
 #' @return If `envir` is NULL returns a list of opened connections. Otherwise
 #'         connections are assigned into the specified `envir`.
@@ -303,11 +155,12 @@ connectAndCheck <- function(key, url, ...)
 #'              url          = 'https://<INSTITUTIONS_REDCAP_DOMAIN>/api/') 
 #' }
 #' @export
+#' @importFrom shelter unlockKeys
 unlockREDCap    <- function(connections,
                             url,
                             keyring,
                             envir       = NULL,
-                            passwordFUN = .default_pass(),
+                            service     = 'redcapAPI',
                             ...)
 {
    ###########################################################################
@@ -319,62 +172,16 @@ unlockREDCap    <- function(connections,
   checkmate::assert_character(x = url,          null.ok = FALSE, add = coll)
   checkmate::assert_character(x = keyring,      null.ok = FALSE, add = coll)
   checkmate::assert_character(x = connections,  null.ok = FALSE, add = coll)
-  checkmate::assert_function( x = passwordFUN,  null.ok = FALSE, add = coll)
   checkmate::assert_class(    x = envir,        null.ok = TRUE,  add = coll, classes="environment")
+  checkmate::assert_character(x = service,       null.ok = FALSE, add = coll)
   checkmate::reportAssertions(coll)
-
-  # Use YAML config if it exists
-  dest <- .unlockYamlOverride(connections, url, ...)
-  if(length(dest) > 0) 
-    return(if(is.null(envir)) dest else list2env(dest, envir=envir))
-
-  # Use ENV if it exists and YAML does not exist
-  dest <- .unlockENVOverride(connections, url, ...)
-  if(length(dest) > 0)
-    return(if(is.null(envir)) dest else list2env(dest, envir=envir))
-
-  .unlockKeyring(keyring, passwordFUN)
-
-  # Open Connections
-  dest <- lapply(seq_along(connections), function(i)
-  {
-    stored <- connections[i] %in% keyring::key_list("redcapAPI", keyring)[,2]
-
-    api_key <- if(stored)
-    {
-      keyring::key_get("redcapAPI", connections[i], keyring)
-    } else 
-    {
-      passwordFUN(paste0("Please enter REDCap API_KEY for '", connections[i], "'."))
-    }
-
-    if(is.null(api_key) || api_key == '') stop(paste("No API_KEY entered for", connections[i]))
-
-    conn <- NULL
-    while(is.null(conn))
-    {
-      conn <- connectAndCheck(api_key, url, ...)
-      if(is.null(conn))
-      {
-        keyring::key_delete("redcapAPI", unname(connections[i]), keyring)
-        api_key <- passwordFUN(paste0(
-          "Invalid API_KEY for '", connections[i],
-          "' in keyring '", keyring,
-          "'. Possible causes include: mistyped, renewed, or revoked.",
-          " Please enter a new key or cancel to abort."))
-        if(is.null(api_key) || api_key == '') stop("unlockREDCap aborted")
-      } else if(!stored)
-      {
-        keyring::key_set_with_value( service="redcapAPI",
-                            username=unname(connections[i]),
-                            password=api_key,
-                            keyring=keyring)
-      }
-    }
-    conn
-  })
-  names(dest) <- if(is.null(names(connections))) connections else names(connections)
 
-  if(is.null(envir)) dest else list2env(dest, envir=envir)
+   ###########################################################################
+  ## Do it
+  unlockKeys(connections,
+             keyring,
+             function(key) connectAndCheck(key, url, ...),
+             envir=envir,
+             service=service,
+             ...)
 }
-

README.md

@@ -133,6 +133,12 @@ There are several vignettes with helpful information and examples to explore. Th
 * redcapAPI-best-practices 
 * redcapAPI-offline-connection 
 
+## Dependencies
+
+We strive to keep the dependency chain as minimal as possible. This reduces potential breakage due to downstream packages getting changed and minimizes install time. 
+
+![Dependency Plot](./inst/image/dependencies.png "Dependency Plot")
+
 ## Back Matter
 
 *NOTE*: Ownership transfer of this package to [VUMC Biostatistics](https://www.vumc.org/biostatistics/vanderbilt-department-biostatistics) is complete.