Merge branch 'master' of https://github.com/ropensci/plotly into feature/transmit

Author: cpsievert

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via Plotly's JavaScript Graphing Library
-Version: 2.4.1
+Version: 2.4.3
 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "cpsievert1@gmail.com"),
     person("Chris", "Parmer", role = c("aut", "cph"),

NEWS

@@ -1,3 +1,11 @@
+2.4.3 -- 11 Feb 2015
+
+Ensure that we always return HTTPS links. Fixes #455
+
+2.4.2 -- 9 Feb 2015
+
+Fix for on-premise domain configuration. 
+
 2.4.1 -- 2 Feb 2015
 
 Attach base_url in as.widget() so it works in multiple contexts

R/figure.R

@@ -18,7 +18,7 @@
 get_figure <- function(username, id) {
   if (missing(username)) username <- verify("username")
   if (missing(id)) stop("Please provide a figure id number")
-  base_url <- file.path("https://plot.ly/apigetfile", username, id)
+  base_url <- file.path(get_domain(), "apigetfile", username, id)
   resp <- httr::GET(base_url, plotly_headers(), httr::config(ssl_verifypeer=FALSE))
   process(struct(resp, "figure"))
 }

R/plotly_POST.R

@@ -71,7 +71,7 @@ plotly_POST <- function(x, filename, fileopt = "new",
     args = to_JSON(x$data),
     kwargs = to_JSON(x[get_kwargs()])
   )
-  base_url <- "https://plot.ly/clientresp"
+  base_url <- file.path(get_domain(), "clientresp")
   resp <- httr::POST(base_url, body = bod)
   con <- process(struct(resp, "clientresp"))
   if (sharing[1] == "hidden") {

R/process.R

@@ -9,6 +9,8 @@ process <- function(resp) {
 process.clientresp <- function(resp) {
   httr::stop_for_status(resp)
   con <- from_JSON(httr::content(resp, as = "text"))
+  # make sure that we always return a HTTPS link
+  con$url <- sub("^http[s]?:", "https:", con$url)
   if (nchar(con$error) > 0) stop(con$error, call. = FALSE)
   if (nchar(con$warning) > 0) warning(con$warning, call. = FALSE)
   if (nchar(con$message) > 0) message(con$message, call. = FALSE)
@@ -27,6 +29,8 @@ process.figure <- function(resp) {
   con <- from_JSON(content(resp, as = "text"))
   fig <- con$payload$figure
   fig$url <- sub("apigetfile/", "~", resp$url)
+  # make sure that we always return a HTTPS link
+  con$url <- sub("^http[s]?:", "https:", con$url)
   fig <- add_boxed(fig)
   fig$data[[1]]$inherit <- FALSE
   # any reasonable way to return a data frame?

R/signup.R

@@ -43,7 +43,7 @@ signup <- function(username, email, save = TRUE) {
     platform = "R",
     version = as.character(packageVersion("plotly"))
   )
-  base_url <- "https://plot.ly/apimkacct"
+  base_url <- file.path(get_domain(), "apimkacct")
   resp <- httr::POST(base_url, body = bod)
   con <- process(struct(resp, "signup"))
   if (save) {