forked from r-lib/httr
-
Notifications
You must be signed in to change notification settings - Fork 0
/
oauth-cache.R
107 lines (84 loc) · 2.45 KB
/
oauth-cache.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
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
use_cache <- function(cache = getOption("httr_oauth_cache")) {
if (length(cache) != 1) {
stop("cache should be length 1 vector", call. = FALSE)
}
if (!is.logical(cache) && !is.character(cache)) {
stop("Cache must either be logical or string (file path)")
}
# If missing, see if it's ok to use one, and cache the results of
# that check in a global option.
if (is.na(cache)) {
cache <- can_use_cache()
options("httr_oauth_cache" = cache)
}
## cache is now TRUE, FALSE or path
if (isFALSE(cache)) {
return(NULL)
}
if (isTRUE(cache)) {
cache <- ".httr-oauth"
}
if (!file.exists(cache)) {
create_cache(cache)
}
return(cache)
}
can_use_cache <- function(path = ".httr-oauth") {
file.exists(path) || should_cache(path)
}
should_cache <- function(path = ".httr-oauth") {
if (!interactive()) return(FALSE)
cat("Use a local file ('", path, "'), to cache OAuth access credentials ",
"between R sessions?\n", sep = "")
utils::menu(c("Yes", "No")) == 1
}
create_cache <- function(path = ".httr-oauth") {
file.create(path, showWarnings = FALSE)
if (!file.exists(path)) {
stop("Failed to create local cache ('", path, "')", call. = FALSE)
}
# Protect cache as much as possible
Sys.chmod(path, "0600")
if (file.exists("DESCRIPTION")) {
add_line(".Rbuildignore", paste0("^", gsub("\\.", "\\\\.", path), "$"))
}
add_line(".gitignore", path)
TRUE
}
add_line <- function(path, line, quiet = FALSE) {
if (file.exists(path)) {
lines <- readLines(path, warn = FALSE)
lines <- lines[lines != ""]
} else {
lines <- character()
}
if (line %in% lines) return(TRUE)
if (!quiet) message("Adding ", line, " to ", path)
lines <- c(lines, line)
writeLines(lines, path)
TRUE
}
cache_token <- function(token, cache_path) {
if (is.null(cache_path)) return()
tokens <- load_cache(cache_path)
tokens[[token$hash()]] <- token
saveRDS(tokens, cache_path)
}
fetch_cached_token <- function(hash, cache_path) {
if (is.null(cache_path)) return()
load_cache(cache_path)[[hash]]
}
remove_cached_token <- function(token) {
if (is.null(token$cache_path)) return()
tokens <- load_cache(token$cache_path)
tokens[[token$hash()]] <- NULL
saveRDS(tokens, token$cache_path)
}
load_cache <- function(cache_path) {
if (!file.exists(cache_path) || file_size(cache_path) == 0) {
list()
} else {
readRDS(cache_path)
}
}
file_size <- function(x) file.info(x, extra_cols = FALSE)$size