version 0.6

DESCRIPTION

@@ -2,8 +2,8 @@ Package: rsconnect
 Type: Package
 Title: Deployment Interface for R Markdown Documents and Shiny
         Applications
-Version: 0.5
-Date: 2016-10-16
+Version: 0.6
+Date: 2016-11-21
 Author: JJ Allaire
 Maintainer: JJ Allaire <jj@rstudio.com>
 Description: Programmatic deployment interface for 'RPubs', 'shinyapps.io', and
@@ -17,6 +17,6 @@ Enhances: BiocInstaller
 License: GPL-2
 RoxygenNote: 5.0.1
 NeedsCompilation: no
-Packaged: 2016-10-16 23:31:08 UTC; jjallaire
+Packaged: 2016-11-21 16:26:59 UTC; jjallaire
 Repository: CRAN
-Date/Publication: 2016-10-17 01:50:35
+Date/Publication: 2016-11-21 21:22:47

MD5

@@ -1,22 +1,22 @@
-f8ffc6724c3488001c67b5cd6cdaaee4 *DESCRIPTION
+d3ea593de2e8ee15ef586e76a0574db0 *DESCRIPTION
 a8e4b139910cce5d821bb3165163d8eb *NAMESPACE
 cff8534ef22c0bdb95c6037fcea5bc74 *R/accounts.R
 328d0a9600c86a64ce060969ac91af6f *R/applications.R
 8424bebb2a0beee59ea679dd51a46c0d *R/auth.R
-cb39a2b710b9625511ab8190fdd98bb0 *R/bundle.R
+77a2f55f9092da306ea4e44c8c7a6092 *R/bundle.R
 b14c2412d4590c93553bdc9cd50cf521 *R/client.R
 6a982c846156bed0d76db4f3ad1b2e07 *R/config.R
-8e95f929d8e9041bf1dd3e6b0144b444 *R/configureApp.R
+c79a575f169982bf557f61fba817c86b *R/configureApp.R
 eefb1a5bea69a04db18a28b4f469df9e *R/connect.R
 90ee6bd083f9362889cf2bf359cbf387 *R/dependencies.R
-91c84fb5889f15c5e8030eae0d8f06db *R/deployApp.R
+95c3eeb55d6ef4d6486b10508524e1ef *R/deployApp.R
 36b4be12142af0178337a12fcf332835 *R/deployDoc.R
-060d8eac49c6a7390ea5cddcd0c89be0 *R/deploySite.R
+89bf53d7ae01cd3c5ab590fcd906f8f1 *R/deploySite.R
 561cd5815502c8c69f5851bd61475f75 *R/deployments.R
-944ed36c2f9d4030253d26ea486ab278 *R/http.R
+60733ab0d105c5be66bd88a34b2ef11c *R/http.R
 67cdbb9d22b484f86dda633a799cde52 *R/ide.R
 94893857b5214d2d6f3302cfdabe25de *R/imports.R
-193235456c17d12529d6a8d7e5aa5a53 *R/lint-framework.R
+c6838a7a11e1b08263e2ec7044533976 *R/lint-framework.R
 656b8c97713c1a6ef464624ad2ea4580 *R/lint-utils.R
 5c33c426bc1e45459b531dae01662b02 *R/linters.R
 2887d129be2b23082bb3adb769a1ed1f *R/locale.R
@@ -33,7 +33,7 @@ d41d8cd98f00b204e9800998ecf8427e *R/static-analysis.R
 e2f0ce632a64c36f55578c1c1b7a9996 *R/terminateApp.R
 e497a332438338d9f8e082e7f609d509 *R/title.R
 d304e24ae2cacf2e86c933c4a92d893e *R/usage.R
-d001133841e767d6020fd403307a4171 *R/utils.R
+0f6e15d53042cdcab3d794fe5297618e *R/utils.R
 5cce34889f56dce293f6864a48357e0c *README.md
 489f971dab5501dc695fb7a6ee19a374 *inst/cert/cacert.pem
 0e676d39107e483449f030931e762249 *inst/examples/diamonds/server.R
@@ -47,18 +47,18 @@ fa01b42fc2c963a8015843b995122bca *man/addLinter.Rd
 e224b0ad5d4690fcb42a6d40774e9231 *man/appDependencies.Rd
 1d89a76d4083ac835e2a58b83de22313 *man/applications.Rd
 028703e29901f5ab20b85d7a8af27a56 *man/authorizedUsers.Rd
-9ec2509d69ec08566952581931051b4c *man/configureApp.Rd
+65bd78c61f49267cc1d8512c97c65a63 *man/configureApp.Rd
 94956d4347e48e58d1c946077a7a26b7 *man/connectUser.Rd
-0e6814ac22001c3e1641ed805cddabd0 *man/deployApp.Rd
+5607ad9c5eefd3194a75b80ac1a5e79b *man/deployApp.Rd
 81e4a73ac89f4368c3d86d3f6c0f61f7 *man/deployDoc.Rd
-23a175a3cf0ebf3377df731fdd358ada *man/deploySite.Rd
+d9866aa54f8f098cb6eccd9543c422c0 *man/deploySite.Rd
 fd650d746beacaff226a7164db44d9c3 *man/deployments.Rd
 f36da5071300ba41c04cccc4da51f46b *man/generateAppName.Rd
 f41ec397391215d328db9afc28bb051b *man/lint.Rd
 bf0eb6b87c38b2bb8aa11a3bc562433d *man/linter.Rd
 e8f2f72b58f963d54ecca44dd38ae0ac *man/listBundleFiles.Rd
 846a2554ba89618a5a4aee9e65721f66 *man/makeLinterMessage.Rd
-a01493c38fbd20419c3b7afd517cc646 *man/options.Rd
+0d27a73958e16a0019c35dc7923839c3 *man/options.Rd
 775faea4c583e994d1b7f82b64ec8fed *man/packages.Rd
 4d611c0f73c70247eb521ea87fdbe88f *man/proxies.Rd
 1ad302fa4208bbfd9118b06edf8d7af5 *man/removeAuthorizedUser.Rd

R/bundle.R

@@ -18,10 +18,34 @@ bundleAppDir <- function(appDir, appFiles, appPrimaryDoc = NULL) {
     if (!file.exists(dirname(to)))
       dir.create(dirname(to), recursive = TRUE)
     file.copy(from, to)
+
+    # ensure .Rprofile doesn't call packrat/init.R
+    if (basename(to) == ".Rprofile") {
+      origRprofile <- readLines(to)
+      msg <- paste0("# Modified by rsconnect package ", packageVersion("rsconnect"), " on ", Sys.time(), ":")
+      replacement <- paste(msg,
+                           "# Packrat initialization disabled in published application",
+                           '# source(\"packrat/init.R\")', sep="\n")
+      newRprofile <- gsub( 'source(\"packrat/init.R\")',
+                           replacement,
+                           origRprofile, fixed = TRUE)
+      cat(newRprofile, file=to, sep="\n")
+    }
+
   }
   bundleDir
 }
 
+isKnitrCacheDir <- function(subdir, contents) {
+  if (grepl("^.+_cache$", subdir)) {
+    stem <- substr(subdir, 1, nchar(subdir) - nchar("_cache"))
+    rmd <- paste0(stem, ".Rmd")
+    tolower(rmd) %in% tolower(contents)
+  } else {
+    FALSE
+  }
+}
+
 maxDirectoryList <- function(dir, parent, totalSize) {
   # generate a list of files at this level
   contents <- list.files(dir, recursive = FALSE, all.files = TRUE,
@@ -53,6 +77,10 @@ maxDirectoryList <- function(dir, parent, totalSize) {
            "rsconnect", "packrat", ".svn", ".git", ".Rproj.user"))
         next
 
+      # ignore knitr _cache directories
+      if (isKnitrCacheDir(subdir, contents))
+        next
+
       # get the list of files in the subdirectory
       dirList <- maxDirectoryList(file.path(dir, subdir),
                                   if (nchar(parent) == 0) subdir
@@ -470,7 +498,22 @@ addPackratSnapshot <- function(bundleDir, implicit_dependencies = c()) {
   }
 
   # generate the packrat snapshot
-  performPackratSnapshot(bundleDir)
+  tryCatch({
+    performPackratSnapshot(bundleDir)
+  }, error = function(e) {
+    # if an error occurs while generating the snapshot, add a header to the
+    # message for improved attribution
+    e$msg <- paste0("----- Error snapshotting dependencies (Packrat) -----\n",
+                    e$msg)
+
+    # print a traceback if enabled
+    if (isTRUE(getOption("rsconnect.error.trace"))) {
+      traceback(3, sys.calls())
+    }
+
+    # rethrow error so we still halt deployment
+    stop(e)
+  })
 
   # if we emitted a temporary dependency file for packrat's benefit, remove it
   # now so it isn't included in the bundle sent to the server
@@ -544,6 +587,12 @@ performPackratSnapshot <- function(bundleDir) {
   on.exit(packrat::opts$snapshot.recommended.packages(srp, persist = FALSE),
           add = TRUE)
 
+  # attempt to eagerly load the BiocInstaller package if installed, to work
+  # around an issue where attempts to load the package could fail within a
+  # 'suppressMessages()' context
+  if (length(find.package("BiocInstaller", quiet = TRUE)))
+    requireNamespace("BiocInstaller", quietly = TRUE)
+
   # generate a snapshot
   suppressMessages(
     packrat::.snapshotImpl(project = bundleDir,

R/configureApp.R

@@ -2,6 +2,8 @@
 #'
 #' Configure an application running on a remote server.
 #'
+#' @inheritParams deployApp
+#'
 #' @param appName Name of application to configure
 #' @param appDir Directory containing application. Defaults to
 #'   current working directory.
@@ -12,8 +14,6 @@
 #' @param redeploy Re-deploy application after its been configured.
 #' @param size Configure application instance size
 #' @param instances Configure number of application instances
-#' @param quiet Request that no status information be printed to the console
-#'   during the deployment.
 #' @examples
 #' \dontrun{
 #'
@@ -24,13 +24,13 @@
 #' @export
 configureApp <- function(appName, appDir=getwd(), account = NULL, server = NULL,
                          redeploy = TRUE, size = NULL,
-                         instances = NULL, quiet = FALSE) {
+                         instances = NULL, logLevel = c("normal", "quiet", "verbose")) {
 
   # resolve target account and application
   accountDetails <- accountInfo(resolveAccount(account, server), server)
   application <- resolveApplication(accountDetails, appName)
 
-  displayStatus <- displayStatus(quiet)
+  displayStatus <- displayStatus(identical(logLevel, "quiet"))
 
   # some properties may required a rebuild to take effect
   rebuildRequired = FALSE
@@ -61,7 +61,7 @@ configureApp <- function(appName, appDir=getwd(), account = NULL, server = NULL,
   # redeploy application if requested
   if (redeploy) {
     if (length(properties) > 0) {
-      deployApp(appDir=appDir, appName=appName, account=account, quiet=quiet, upload=rebuildRequired)
+      deployApp(appDir=appDir, appName=appName, account=account, logLevel=logLevel, upload=rebuildRequired)
     }
     else
     {

R/deployApp.R

@@ -40,8 +40,10 @@
 #' @param launch.browser If true, the system's default web browser will be
 #'   launched automatically after the app is started. Defaults to \code{TRUE} in
 #'   interactive sessions only.
-#' @param quiet Request that no status information be printed to the console
-#'   during the deployment.
+#' @param logLevel One of \code{"quiet"}, \code{"normal"} or \code{"verbose"};
+#'   indicates how much logging to the console is to be performed. At
+#'   \code{"quiet"} reports no information; at \code{"verbose"}, a full
+#'   diagnostic log is captured.
 #' @param lint Lint the project before initiating deployment, to identify
 #'   potentially problematic code?
 #' @param metadata Additional metadata fields to save with the deployment
@@ -85,13 +87,54 @@ deployApp <- function(appDir = getwd(),
                       upload = TRUE,
                       launch.browser = getOption("rsconnect.launch.browser",
                                                  interactive()),
-                      quiet = FALSE,
+                      logLevel = c("normal", "quiet", "verbose"),
                       lint = TRUE,
                       metadata = list()) {
 
   if (!isStringParam(appDir))
     stop(stringParamErrorMessage("appDir"))
 
+  # respect log level
+  logLevel <- match.arg(logLevel)
+  quiet <- identical(logLevel, "quiet")
+  verbose <- identical(logLevel, "verbose")
+
+  # at verbose log level, turn on all tracing options implicitly for the
+  # duration of the call
+  if (verbose) {
+    options <- c("rsconnect.http.trace",
+                 "rsconnect.http.trace.json",
+                 "rsconnect.error.trace")
+    restorelist <- list()
+    newlist <- list()
+
+    # record options at non-default position
+    for (option in options) {
+      if (!isTRUE(getOption(option))) {
+        restorelist[[option]] <- FALSE
+        newlist[[option]] <- TRUE
+      }
+    }
+
+    # apply new option values
+    options(newlist)
+
+    # restore all old option values on exit
+    on.exit(options(restorelist), add = TRUE)
+  }
+
+  # install error handler if requested
+  if (isTRUE(getOption("rsconnect.error.trace"))) {
+    errOption <- getOption("error")
+    options(error = function(e) {
+      cat("----- Deployment error -----\n")
+      cat(geterrmessage(), "\n")
+      cat("----- Error stack trace -----\n")
+      traceback(3, sys.calls())
+    })
+    on.exit(options(error = errOption), add = TRUE)
+  }
+
   # normalize appDir path and ensure it exists
   appDir <- normalizePath(appDir, mustWork = FALSE)
   if (!file.exists(appDir)) {
@@ -118,14 +161,22 @@ deployApp <- function(appDir = getwd(),
         grepl("\\.html?$", appDir, ignore.case = TRUE)) {
       return(deployDoc(appDir, appName = appName, appTitle = appTitle,
                        account = account, server = server, upload = upload,
-                       launch.browser = launch.browser, quiet = quiet,
+                       launch.browser = launch.browser, logLevel = logLevel,
                        lint = lint))
     } else {
       stop(appDir, " must be a directory, an R Markdown document, or an HTML ",
            "document.")
     }
   }
 
+  # at verbose log level, generate header
+  if (verbose) {
+    cat("----- Deployment log started at ", as.character(Sys.time()), " -----\n")
+    cat("Deploy command:", "\n", deparse(sys.call(1)), "\n\n")
+    cat("Session information: \n")
+    print(utils::sessionInfo())
+  }
+
   # figure out what kind of thing we're deploying
   if (!is.null(contentCategory)) {
     assetTypeName <- contentCategory
@@ -223,6 +274,8 @@ deployApp <- function(appDir = getwd(),
 
   if (upload) {
     # create, and upload the bundle
+    if (verbose)
+      cat("----- Bundle upload started at ", as.character(Sys.time()), " -----\n")
     withStatus(paste0("Uploading bundle for ", assetTypeName, ": ",
                      application$id), {
       bundlePath <- bundleApp(target$appName, appDir, appFiles,
@@ -250,6 +303,10 @@ deployApp <- function(appDir = getwd(),
   displayStatus(paste0("Deploying bundle: ", bundle$id,
                        " for ", assetTypeName, ": ", application$id,
                        " ...\n", sep=""))
+  if (verbose) {
+    cat("----- Server deployment started at ", as.character(Sys.time()), " -----\n")
+  }
+
   task <- client$deployApplication(application$id, bundle$id)
   taskId <- if (is.null(task$task_id)) task$id else task$task_id
   response <- client$waitForTask(taskId, quiet)
@@ -289,6 +346,10 @@ deployApp <- function(appDir = getwd(),
     FALSE
   }
 
+  if (verbose) {
+    cat("----- Deployment log finished at ", as.character(Sys.time()), " -----\n")
+  }
+
   invisible(deploymentSucceeded)
 }
 

R/deploySite.R

@@ -23,7 +23,7 @@ deploySite <- function(siteDir = getwd(),
                        server = NULL,
                        render = c("none", "local", "server"),
                        launch.browser = getOption("rsconnect.launch.browser", interactive()),
-                       quiet = FALSE,
+                       logLevel = c("quiet", "normal", "verbose"),
                        lint = FALSE,
                        metadata = list()) {
 
@@ -60,7 +60,7 @@ deploySite <- function(siteDir = getwd(),
     siteGenerator$render(input_file = NULL,
                          output_format = NULL,
                          envir = new.env(),
-                         quiet = quiet,
+                         quiet = identical(match.arg(logLevel), "quiet"),
                          encoding = getOption("encoding"))
   }
 
@@ -94,7 +94,7 @@ deploySite <- function(siteDir = getwd(),
             account = account,
             server = server,
             launch.browser = launch.browser,
-            quiet = quiet,
+            logLevel = logLevel,
             lint = lint,
             metadata = metadata)
 }

R/http.R

@@ -353,7 +353,7 @@ httpRCurl <- function(protocol,
       # ignore errors resulting from timeout or user abort
       if (identical(e$message, "Callback aborted") ||
           identical(e$message, "transfer closed with outstanding read data remaining"))
-        return
+        return(NULL)
       # bubble remaining errors through
       else
         stop(e)

R/lint-framework.R

@@ -115,7 +115,7 @@ lint <- function(project, files = NULL, appPrimaryDoc = NULL) {
               !is.null(appPrimaryDoc) &&
                 tolower(tools::file_ext(appPrimaryDoc)) == "r"),
     Rmd = any(grepl(glob2rx("*.rmd"), appFilesBase)),
-    static = any(grepl("^.*\\.html?$", appFilesBase))
+    static = any(grepl("(?:html?|pdf)$", appFilesBase))
   )
 
   if (!any(satisfiedLayouts)) {
@@ -125,7 +125,7 @@ lint <- function(project, files = NULL, appPrimaryDoc = NULL) {
             2. 'shiny.R' and 'www/index.html' in the application base directory,
             3. 'app.R' or a single-file Shiny .R file,
             4. An R Markdown (.Rmd) document,
-            5. A static HTML (.html) document."
+            5. A static HTML (.html) or PDF (.pdf) document."
 
     # strip leading whitespace from the above
     msg <- paste(collapse = "\n",
@@ -142,8 +142,8 @@ lint <- function(project, files = NULL, appPrimaryDoc = NULL) {
   }))
 
   # Read in the files
-  # TODO: perform this task more lazily?
-  projectContent <- suppressWarnings(lapply(projectFilesToLint, readLines))
+  encoding <- activeEncoding(project)
+  projectContent <- suppressWarnings(lapply(projectFilesToLint, readLines, encoding = encoding))
   names(projectContent) <- projectFilesToLint
   lintResults <- vector("list", length(linters))
   names(lintResults) <- names(linters)