1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370
|
#' Account Management Functions
#'
#' Functions to enumerate and remove accounts on the local system. Prior to
#' deploying applications you need to register your account on the local system.
#'
#' You register an account using the [setAccountInfo()] function (for
#' ShinyApps) or [connectUser()] function (for other servers). You can
#' subsequently remove the account using the `removeAccount` function.
#'
#' The `accounts` and `accountInfo` functions are provided for viewing
#' previously registered accounts.
#'
#' @param name Name of account
#' @param server Name of the server on which the account is registered
#' (optional; see [servers()])
#'
#' @return `accounts` returns a data frame with the names of all accounts
#' registered on the system and the servers on which they reside.
#' `accountInfo` returns a list with account details.
#'
#' @rdname accounts
#' @export
accounts <- function(server = NULL) {
configPaths <- accountConfigFiles(server)
names <- file_path_sans_ext(basename(configPaths))
servers <- basename(dirname(configPaths))
servers[servers == "."] <- "shinyapps.io"
data.frame(name = names, server = servers, stringsAsFactors = FALSE)
}
#' Register account on Posit Connect
#
#' @description
#' `connectUser()` and `connectApiUser()` connect your Posit Connect account to
#' the rsconnect package so that it can deploy and manage applications on
#' your behalf.
#'
#' `connectUser()` is the easiest place to start because it allows you to
#' authenticate in-browser to your Posit Connect server. `connectApiUser()` is
#' appropriate for non-interactive settings; you'll need to copy-and-paste the
#' API key from your account settings.
#'
#' @param account A name for the account to connect.
#' @param server The server to connect to.
#' @param launch.browser If true, the system's default web browser will be
#' launched automatically after the app is started. Defaults to `TRUE` in
#' interactive sessions only. If a function is passed, it will be called
#' after the app is started, with the app URL as a parameter.
#' @param apiKey The API key used to authenticate the user
#' @param quiet Whether or not to show messages and prompts while connecting the
#' account.
#' @family Account functions
#' @export
connectApiUser <- function(account = NULL, server = NULL, apiKey, quiet = FALSE) {
server <- findServer(server)
user <- getAuthedUser(server, apiKey = apiKey)
registerAccount(
serverName = server,
accountName = account %||% user$username,
accountId = user$id,
apiKey = apiKey
)
if (!quiet) {
accountLabel <- accountLabel(user$username, server)
cli::cli_alert_success("Registered account for {accountLabel}")
}
invisible()
}
#' @rdname connectApiUser
#' @export
connectUser <- function(account = NULL,
server = NULL,
quiet = FALSE,
launch.browser = getOption("rsconnect.launch.browser", interactive())) {
server <- findServer(server)
resp <- getAuthTokenAndUser(server, launch.browser)
registerAccount(
serverName = server,
accountName = account %||% resp$user$username,
accountId = resp$user$id,
token = resp$token$token,
private_key = resp$token$private_key
)
if (!quiet) {
accountLabel <- accountLabel(resp$user$username, server)
cli::cli_alert_success("Registered account for {accountLabel}")
}
invisible()
}
getAuthTokenAndUser <- function(server, launch.browser = TRUE) {
token <- getAuthToken(server)
if (isTRUE(launch.browser))
utils::browseURL(token$claim_url)
else if (is.function(launch.browser))
launch.browser(token$claim_url)
if (isFALSE(launch.browser)) {
cli::cli_alert_warning("Open {.url {token$claim_url}} to authenticate")
} else {
cli::cli_alert_info("A browser window should open to complete authentication")
cli::cli_alert_warning("If it doesn't open, please go to {.url {token$claim_url}}")
}
user <- waitForAuthedUser(
server,
token = token$token,
private_key = token$private_key
)
list(
token = token,
user = user
)
}
# Used by the IDE
getAuthToken <- function(server, userId = 0) {
token <- generateToken()
# Send public key to server, and generate URL where the token can be claimed
account <- list(server = server)
client <- clientForAccount(account)
response <- client$addToken(list(
token = token$token,
public_key = token$public_key,
user_id = 0L
))
list(
token = token$token,
private_key = secret(token$private_key),
claim_url = response$token_claim_url
)
}
# generateToken generates a token for signing requests sent to the Posit
# Connect service. The token's ID and public key are sent to the server, and
# the private key is saved locally.
generateToken <- function() {
key <- openssl::rsa_keygen(2048L)
priv.der <- openssl::write_der(key)
pub.der <- openssl::write_der(key$pubkey)
tokenId <- paste(c("T", openssl::rand_bytes(16)), collapse = "")
list(
token = tokenId,
public_key = openssl::base64_encode(pub.der),
private_key = openssl::base64_encode(priv.der)
)
}
waitForAuthedUser <- function(server,
token = NULL,
private_key = NULL,
apiKey = NULL) {
# keep trying to authenticate until we're successful; server returns
# 500 "Token is unclaimed error" while waiting for interactive auth to complete
cli::cli_progress_bar(format = "{cli::pb_spin} Waiting for authentication...")
repeat {
for (i in 1:10) {
Sys.sleep(0.1)
cli::cli_progress_update()
}
user <- tryCatch(
getAuthedUser(
server,
token = token,
private_key = private_key,
apiKey = apiKey
),
rsconnect_http_500 = function(err) NULL
)
if (!is.null(user)) {
cli::cli_progress_done()
break
}
}
user
}
getAuthedUser <- function(server,
token = NULL,
private_key = NULL,
apiKey = NULL) {
if (!xor(is.null(token) && is.null(private_key), is.null(apiKey))) {
cli::cli_abort("Must supply either {.arg token} + {private_key} or {.arg apiKey}")
}
account <- list(
server = server,
apiKey = apiKey,
token = token,
private_key = private_key
)
client <- clientForAccount(account)
client$currentUser()
}
#' Register account on shinyapps.io or posit.cloud
#'
#' Configure a ShinyApps or Posit Cloud account for publishing from this system.
#'
#' @param name Name of account to save or remove
#' @param token User token for the account
#' @param secret User secret for the account
#' @param server Server to associate account with.
#'
#' @examples
#' \dontrun{
#'
#' # register an account
#' setAccountInfo("user", "token", "secret")
#'
#' # remove the same account
#' removeAccount("user")
#' }
#'
#' @family Account functions
#' @export
setAccountInfo <- function(name, token, secret, server = "shinyapps.io") {
check_string(name)
check_string(token)
check_string(secret)
check_string(server)
accountId <- findShinyAppsAccountId(name, token, secret, server)
registerAccount(
serverName = server,
accountName = name,
accountId = accountId,
token = token,
secret = secret
)
invisible()
}
# A user can have multiple accounts, so iterate over all accounts looking
# for one with the specified name
findShinyAppsAccountId <- function(name,
token,
secret,
server,
error_call = caller_env()) {
if (secret == "<SECRET>") {
cli::cli_abort(
c(
"You've copied and pasted the wrong thing.",
i = "Either click 'Show secret' or 'Copy to clipboard'."
),
call = error_call
)
}
account <- list(token = token, secret = secret, server = server)
client <- clientForAccount(account)
userId <- client$currentUser()$id
accountId <- NULL
accounts <- client$accountsForUser(userId)
for (account in accounts) {
if (identical(account$name, name)) {
return(account$id)
}
}
cli::cli_abort("Unable to determine {.arg accountId} for account {.str {name}}")
}
#' @rdname accounts
#' @family Account functions
#' @export
accountInfo <- function(name = NULL, server = NULL) {
findAccountInfo(name, server)
}
# Discovers then loads details about an account from disk.
# Internal equivalent to accountInfo that lets callers provide error context.
findAccountInfo <- function(name = NULL, server = NULL, error_call = caller_env()) {
fullAccount <- findAccount(name, server, error_call = error_call)
configFile <- accountConfigFile(fullAccount$name, fullAccount$server)
accountDcf <- read.dcf(configFile, all = TRUE)
info <- as.list(accountDcf)
# Account records previously had username, now have name. Internal callers expect "name", but
# external callers may expect "username". (#1024)
info$name <- info$name %||% info$username
info$username <- info$name
# remove all whitespace from private key
if (!is.null(info$private_key)) {
info$private_key <- gsub("[[:space:]]", "", info$private_key)
}
# Hide credentials
info$private_key <- secret(info$private_key)
info$secret <- secret(info$secret)
info$apiKey <- secret(info$apiKey)
info
}
hasAccount <- function(name, server) {
file.exists(accountConfigFile(name, server))
}
#' @rdname accounts
#' @export
removeAccount <- function(name = NULL, server = NULL) {
fullAccount <- findAccount(name, server)
configFile <- accountConfigFile(fullAccount$name, fullAccount$server)
file.remove(configFile)
invisible(NULL)
}
registerAccount <- function(serverName,
accountName,
accountId,
token = NULL,
secret = NULL,
private_key = NULL,
apiKey = NULL) {
check_string(serverName)
check_string(accountName)
if (!is.null(secret)) {
secret <- as.character(secret)
}
fields <- list(
name = accountName,
server = serverName,
accountId = accountId,
token = token,
secret = secret,
private_key = private_key,
apiKey = apiKey
)
path <- accountConfigFile(accountName, serverName)
dir.create(dirname(path), recursive = TRUE, showWarnings = FALSE)
write.dcf(compact(fields), path, width = 100)
# set restrictive permissions on it if possible
if (identical(.Platform$OS.type, "unix"))
Sys.chmod(path, mode = "0600")
path
}
accountLabel <- function(account, server) {
# Note: The incoming "account" may correspond to our local account name, which does not always
# match the remote username.
paste0("server: ", server, " / username: ", account)
}
|