#' Add a new secret to the vault.
#'
#' By default, the newly added secret is not shared with other
#' users. See the users argument if you want to change this.
#' You can also use [share_secret()] later, to specify the users that
#' have access to the secret.
#'
#' @param name Name of the secret, a string that can contain alphanumeric
#' characters, underscores, dashes and dots.
#' @param value Value of the secret, an arbitrary R object that
#' will be serialized using [base::serialize()].
#' @param users Email addresses of users that will have access to the
#' secret. (See [add_user()])
#' @param vault Vault location (starting point to find the vault).
#' To create a vault, use [create_vault()] or [create_package_vault()].
#' If this is `NULL`, then `secret` tries to find the vault automatically:
#' * If the `secret.vault` option is set to path, that is used as the
#' starting point.
#' * Otherwise, if the `R_SECRET_VAULT` environment variable is set to a
#' path, that is used as a starting point.
#' * Otherwise the current working directory is used as the starting
#' point.
#'
#' If the starting point is a vault, that is used. Otherwise, if the
#' starting point is in a package tree, the `inst/vault` folder is used
#' within the package. If no vault can be found, an error is thrown.
#'
#' @family secret functions
#' @export
#' @importFrom openssl aes_keygen aes_cbc_encrypt read_pubkey rsa_encrypt
#' @example inst/examples/example-secret.R
add_secret <- function(name, value, users, vault = NULL) {
assert_that(is_valid_name(name))
assert_that(is_email_addresses(users))
vault <- find_vault(vault)
assert_that(secret_does_not_exist(vault, name))
assert_that(users_exist(vault, users))
## Create an AES key for the secret, and store it
key <- aes_keygen()
store_secret_with_key(name, value, key, vault)
## Share it with the specified users
share_secret_with_key(name, users, aeskey = key, vault = vault)
invisible()
}
#' Retrieve a secret from the vault.
#'
#' @param name Name of the secret.
#' @param key The private RSA key to use. It defaults to the current
#' user's default key.
#' @inheritParams add_secret
#'
#' @family secret functions
#' @export
#' @importFrom openssl rsa_decrypt aes_cbc_decrypt
#' @example inst/examples/example-secret.R
get_secret <- function(name, key = local_key(), vault = NULL) {
assert_that(is_valid_name(name))
vault <- find_vault(vault)
secret_file <- get_secret_file(vault, name)
if (! file.exists(secret_file)) {
stop("secret ", sQuote(name), " does not exist")
}
## Try to decrypt all AES encryptions, to see if user has access
aeskey <- try_get_aes_key(vault, name, key)
if (is.null(aeskey)) stop("Access denied to secret ", sQuote(name))
secret <- unserialize(read_raw(secret_file))
data <- aes_cbc_decrypt(secret, aeskey)
unserialize(data)
}
#' Update a secret in the vault.
#'
#' @inheritParams get_secret
#' @inheritParams add_secret
#'
#' @family secret functions
#' @export
#' @importFrom openssl aes_keygen
update_secret <- function(name, value, key = local_key(), vault = NULL) {
assert_that(is_valid_name(name))
vault <- find_vault(vault)
secret_file <- get_secret_file(vault, name)
if (! file.exists(secret_file)) {
stop("secret ", sQuote(name), " does not exist")
}
## Need a new AES key, because we might have deleted some users since
## the last value was set. These users still have the old AES key,
## but they should not have access to the new value of the secret.
## See also https://github.com/gaborcsardi/secret/issues/10
aeskey <- aes_keygen()
## Store the secret
store_secret_with_key(name, value, aeskey, vault)
## Give access to the same users
users <- get_secret_user_emails(vault, name)
share_secret_with_key(name, users, aeskey = aeskey, vault = vault)
invisible()
}
#' Remove a secret from the vault.
#'
#' @param name Name of the secret to delete.
#' @inheritParams add_secret
#'
#' @family secret functions
#' @export
delete_secret <- function(name, vault = NULL) {
assert_that(is_valid_name(name))
vault <- find_vault(vault)
secret_file <- get_secret_file(vault, name)
secret_dir <- dirname(secret_file)
if (!file.exists(secret_dir)) {
stop("Secret ", sQuote(name), " does not exist.")
}
unlink(secret_dir, recursive = TRUE)
invisible()
}
#' List all secrets.
#'
#' Returns a data frame with secrets and emails that these are shared with.
#' The emails are in a list-column, each element of the `email` column is
#' a character vector.
#'
#' @inheritParams add_secret
#'
#' @family secret functions
#' @return data.frame
#' @export
list_secrets <- function(vault = NULL) {
vault <- find_vault(vault)
assert_that(is_valid_dir(vault))
secrets <- list.files(
file.path(vault, "secrets"),
recursive = TRUE,
full.names = FALSE,
pattern = ".raw$"
)
secrets <- gsub(".raw$", "", dirname(secrets))
secrets <- sort(secrets)
users <- lapply(
file.path(vault, "secrets", secrets),
dir,
pattern = "\\.enc$"
)
users <- lapply(users, sub, pattern = "\\.enc$", replacement = "")
data.frame(
secret = secrets,
email = I(users),
stringsAsFactors = FALSE
)
}
#' Share a secret among some users.
#'
#' Use this function to extend the set of users that have access to a
#' secret. The calling user must have access to the secret as well.
#'
#' @param key Private key that has access to the secret. (I.e. its
#' corresponding public key is among the vault users.)
#' @param users addresses of users that will have access to the secret.
#' (See [add_user()]).
#' @inheritParams add_secret
#'
#' @seealso [unshare_secret()], [list_owners()] to list users that have
#' access to a secret.
#'
#' @family secret functions
#' @export
share_secret <- function(name, users, key = local_key(), vault = NULL) {
assert_that(is_valid_name(name))
assert_that(is_email_addresses(users))
vault <- find_vault(vault)
assert_that(secret_exists(vault, name))
assert_that(users_exist(vault, users))
aeskey <- try_get_aes_key(vault, name, key)
if (is.null(aeskey)) stop("Access denied to secret ", sQuote(name))
share_secret_with_key(name, users, aeskey, vault)
invisible()
}
#' List users that have access to a secret
#'
#' @inheritParams add_secret
#'
#' @family secret functions
#' @export
list_owners <- function(name, vault = NULL) {
assert_that(is_valid_name(name))
vault <- find_vault(vault)
get_secret_user_emails(name, vault = vault)
}
#' Unshare a secret among some users.
#'
#' Use this function to restrict the set of users that have access to a
#' secret. Note that users may still have access to the secret, through
#' version control history, or if they have a copy of the project. They
#' will not have access to future values of the secret, though.
#'
#' @inheritParams add_secret
#'
#' @seealso [share_secret()]
#'
#' @family secret functions
#' @export
unshare_secret <- function(name, users, vault = NULL) {
assert_that(is_valid_name(name))
assert_that(is_email_addresses(users))
vault <- find_vault(vault)
assert_that(secret_exists(vault, name))
assert_that(users_exist(vault, users))
files <- vapply(users, get_secret_user_file, "",
vault = vault, name = name)
files <- Filter(file.exists, files)
file.remove(files)
invisible()
}
# Internals -------------------------------------------------------------
secret_exists <- function(vault, name) {
file.exists(get_secret_file(vault, name))
}
on_failure(secret_exists) <- function(call, env) {
paste0("Secret ", deparse(call$name), " does not exist")
}
secret_does_not_exist <- function(vault, name) {
! secret_exists(vault, name)
}
on_failure(secret_does_not_exist) <- function(call, env) {
paste0("Secret ", deparse(call$name), " already exists")
}
#' Share a secret, its AES key is known already.
#'
#' @param name Name of the secret.
#' @param users Email addresses of users.
#' @param aeskey AES key of the secret.
#' @param vault Vault directory.
#'
#' @keywords internal
share_secret_with_key <- function(name, users, aeskey, vault) {
lapply(users, share_secret_with_key1,
name = name, aeskey = aeskey, vault = vault)
}
#' Share a secret with a single user, AES key is known.
#'
#' @param name Name of the secret.
#' @param email Email address of the user.
#' @param aeskey The AES key of the secret.
#' @param vault Vault directory.
#'
#' @keywords internal
share_secret_with_key1 <- function(name, email, aeskey, vault) {
secret_user_file <- get_secret_user_file(vault, name, email)
rsa_key <- get_user_key(vault, email)
encaes <- rsa_encrypt(serialize(aeskey, NULL), rsa_key)
create_dir(dirname(secret_user_file))
writeBin(encaes, secret_user_file)
}
#' Try to get the AES key of a secret, using a private RSA key.
#'
#' We just try the private key against all encrypted copies of the
#' AES key. If none of the succeed, then we return `NULL`. Otherwise
#' we return the AES key, an `aes` object, from the `openssl` package.
#'
#' @keywords internal
try_get_aes_key <- function(vault, name, key) {
file <- get_secret_user_file_for_key(vault, name, key)
if (is.null(file) || !file.exists(file)) return(NULL)
tryCatch(
unserialize(rsa_decrypt(read_raw(file), key = key)),
error = function(e) NULL
)
}
#' Store a secret, encrypted with its AES key.
#'
#' @param name Name of secret.
#' @param value Value of secret.
#' @param key The AES key, an `aes` object from the `openssl` package.
#' @param vault Vault directory.
#'
#' @keywords internal
store_secret_with_key <- function(name, value, key, vault) {
## Encrypt the secret with it
data <- serialize(value, NULL)
enc <- aes_cbc_encrypt(data, key)
## Write it out
secret_file <- get_secret_file(vault, name)
create_dir(dirname(secret_file))
writeBin(serialize(enc, NULL), secret_file)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.