Merge pull request #235 from cboettig/master

Work around listener errors introduced in #211
r-lib · May 22, 2015 · e8a85c0 · e8a85c0
2 parents 6092f2e + 71fb959
commit e8a85c0
Show file tree

Hide file tree

Showing 4 changed files with 29 additions and 23 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,13 @@
 # httr 0.6.1.9000
 
+
+* The `oauth_listener` can now listen on
+  a custom IP address and port (the previously hardwired ip:port of `127.0.0.1:1410`
+  is now just the default).  This permits authentication to work under other settings,
+  such as inside docker containers (which require localhost uses `0.0.0.0` instead).
+  To configure, set the system environmental variables `HTTR_LOCALHOST` and `HTTR_PORT`
+  respectively. Thanks @cboettig (#211).
+
 * `POST()`, `PUT()` and `PATCH()` now drop `NULL` body elements this is 
   convenient and consistent with url query params.
 
@@ -39,11 +47,6 @@
   scalars. To prevent this automatic "unboxing", wrap the vector in `I()` 
   (#187).
 
-* `oauth1.0_token` and `oauth2.0_token` now permit the `oauth_listener` to 
-  listen on a custom IP address and port (the previously hardwired ip:port 
-  of `127.0.0.1:1410` is now just the default).  This permits authentication to 
-  work under other settings, such as inside docker containers (which require 
-  localhost uses `0.0.0.0` instead) (#211, @cboettig).
 
 # httr 0.6.1
 

diff --git a/R/oauth-init.R b/R/oauth-init.R
@@ -7,12 +7,10 @@
 #'    \code{\link{oauth_app}}
 #' @param permission optional, a string of permissions to ask for.
 #' @param is_interactive Is the current environment interactive?
-#' @inheritParams oauth_listener 
 #' @export
 #' @keywords internal
 init_oauth1.0 <- function(endpoint, app, permission = NULL,
-                          is_interactive = interactive(),
-                          host = "127.0.0.1", port = 1410) {
+                          is_interactive = interactive()) {
 
   oauth_sig <- function(url, method, token = NULL, token_secret = NULL, ...) {
     oauth_header(oauth_signature(url, method, app, token, token_secret, ...,
@@ -30,7 +28,7 @@ init_oauth1.0 <- function(endpoint, app, permission = NULL,
   authorize_url <- modify_url(endpoint$authorize, query = list(
     oauth_token = token,
     permission = "read"))
-  verifier <- oauth_listener(authorize_url, is_interactive, host, port)$oauth_verifier
+  verifier <- oauth_listener(authorize_url, is_interactive)$oauth_verifier
 
   # 3. Request access token
   response <- POST(endpoint$access,
@@ -52,13 +50,12 @@ init_oauth1.0 <- function(endpoint, app, permission = NULL,
 #'     Otherwise, provide a URL to the user and prompt for a validation
 #'     code. Defaults to the of the \code{"httr_oob_default"} default,
 #'     or \code{TRUE} if \code{httpuv} is not installed.
-#' @inheritParams oauth_listener
+#' @param is_interactive Is the current environment interactive?
 #' @export
 #' @keywords internal
 init_oauth2.0 <- function(endpoint, app, scope = NULL, type = NULL,
                           use_oob = getOption("httr_oob_default"),
-                          is_interactive = interactive(),
-                          host = "127.0.0.1", port = 1410) {
+                          is_interactive = interactive()) {
   if (!use_oob && !is_installed("httpuv")) {
     message("httpuv not installed, defaulting to out-of-band authentication")
     use_oob <- TRUE
@@ -84,7 +81,7 @@ init_oauth2.0 <- function(endpoint, app, scope = NULL, type = NULL,
   if (isTRUE(use_oob)) {
     code <- oauth_exchanger(authorize_url)$code
   } else {
-    code <- oauth_listener(authorize_url, is_interactive, host, port)$code
+    code <- oauth_listener(authorize_url, is_interactive)$code
   }
 
   # Use authorisation code to get (temporary) access token

diff --git a/R/oauth-listener.r b/R/oauth-listener.r
@@ -14,7 +14,7 @@
 #' @param port for the listener
 #' @export
 #' @keywords internal
-oauth_listener <- function(request_url, is_interactive = interactive(), host = "127.0.0.1", port = 1410) {
+oauth_listener <- function(request_url, is_interactive = interactive()) {
   if (!is_installed("httpuv")) {
     stop("httpuv package required to capture OAuth credentials.")
   }
@@ -46,8 +46,8 @@ oauth_listener <- function(request_url, is_interactive = interactive(), host = "
       body = "Authentication complete. Please close this page and return to R."
     )
   }
-
-  server <- httpuv::startServer(host, port, list(call = listen))
+  use <- listener_endpoint()
+  server <- httpuv::startServer(use$host, use$port, list(call = listen))
   on.exit(httpuv::stopServer(server))
 
   message("Waiting for authentication in browser...")
@@ -75,5 +75,13 @@ oauth_listener <- function(request_url, is_interactive = interactive(), host = "
 #' @keywords internal
 #' @export
 oauth_callback <- function() {
-  "http://localhost:1410/"
+	paste0("http://", 
+               Sys.getenv("HTTR_SERVER", "localhost"),
+               ":",
+               Sys.getenv("HTTR_SERVER_PORT", "1410"))
+}
+
+listener_endpoint <- function() {
+  list(host = Sys.getenv("HTTR_LOCALHOST", "127.0.0.1"),
+       port = as.integer(Sys.getenv("HTTR_PORT", "1410")))
 }
diff --git a/R/oauth-token.r b/R/oauth-token.r
@@ -134,8 +134,7 @@ Token <- R6::R6Class("Token", list(
 #' @export
 oauth1.0_token <- function(endpoint, app, permission = NULL,
                            as_header = TRUE,
-                           cache = getOption("httr_oauth_cache"),
-                           host = "127.0.0.1", port = 1410) {
+                           cache = getOption("httr_oauth_cache")) {
   params <- list(permission = permission, as_header = as_header)
 
   Token1.0$new(app = app, endpoint = endpoint, params = params,
@@ -147,7 +146,7 @@ oauth1.0_token <- function(endpoint, app, permission = NULL,
 Token1.0 <- R6::R6Class("Token1.0", inherit = Token, list(
   init_credentials = function(force = FALSE) {
     self$credentials <- init_oauth1.0(self$endpoint, self$app,
-      permission = self$params$permission, host = host, port = port)
+      permission = self$params$permission)
   },
   can_refresh = function() {
     FALSE
@@ -188,8 +187,7 @@ Token1.0 <- R6::R6Class("Token1.0", inherit = Token, list(
 oauth2.0_token <- function(endpoint, app, scope = NULL, type = NULL,
                            use_oob = getOption("httr_oob_default"),
                            as_header = TRUE,
-                           cache = getOption("httr_oauth_cache"),
-                           host = "127.0.0.1", port = 1410) {
+                           cache = getOption("httr_oauth_cache")) {
   params <- list(scope = scope, type = type, use_oob = use_oob,
     as_header = as_header)
   Token2.0$new(app = app, endpoint = endpoint, params = params,
@@ -202,7 +200,7 @@ Token2.0 <- R6::R6Class("Token2.0", inherit = Token, list(
   init_credentials = function() {
     self$credentials <- init_oauth2.0(self$endpoint, self$app,
       scope = self$params$scope, type = self$params$type,
-      use_oob = self$params$use_oob, host = host, port = port)
+      use_oob = self$params$use_oob)
   },
   can_refresh = function() {
     !is.null(self$credentials$refresh_token)