-
Notifications
You must be signed in to change notification settings - Fork 2k
/
oauth-listener.r
77 lines (68 loc) · 2.16 KB
/
oauth-listener.r
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
#' Create a webserver to listen for OAuth callback.
#'
#' This opens a web browser pointing to \code{request_url}, and opens a
#' webserver on port 1410 to listen to the reponse. The redirect url for
#' should be either set previously (during the OAuth authentication) dance
#' or supplied as a parameter to the url. See \code{\link{oauth1.0_token}}
#' and \code{\link{oauth2.0_token}} for examples of both techniques.
#'
#' This function should not normally be called directly by the user.
#'
#' @param request_url the url to send the browser to
#' @param is_interactive Is an interactive environment available?
#' @export
#' @keywords internal
oauth_listener <- function(request_url, is_interactive = interactive()) {
if (!is_installed("httpuv")) {
stop("httpuv package required to capture OAuth credentials.")
}
if (!is_interactive) {
stop("oauth_listener() needs an interactive environment.", call. = FALSE)
}
info <- NULL
listen <- function(env) {
if (!identical(env$PATH_INFO, "/")) {
return(list(
status = 404L,
headers = list("Content-Type" = "text/plain"),
body = "Not found")
)
}
query <- env$QUERY_STRING
if (!is.character(query) || identical(query, "")) {
info <<- NA
} else {
info <<- parse_query(gsub("^\\?", "", query))
}
list(
status = 200L,
headers = list("Content-Type" = "text/plain"),
body = "Authentication complete. Please close this page and return to R."
)
}
server <- httpuv::startServer("127.0.0.1", 1410, list(call = listen))
on.exit(httpuv::stopServer(server))
message("Waiting for authentication in browser...")
message("Press Esc/Ctrl + C to abort")
BROWSE(request_url)
while(is.null(info)) {
httpuv::service()
Sys.sleep(0.001)
}
httpuv::service() # to send text back to browser
if (identical(info, NA)) {
stop("Authentication failed.", call. = FALSE)
}
message("Authentication complete.")
info
}
#' The oauth callback url.
#'
#' The url that \code{\link{oauth_listener}} expects that the client be
#' referred to.
#'
#' @keywords internal
#' @export
oauth_callback <- function() {
"http://localhost:1410/"
}