Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
quarto-dev
GitHub Repository: quarto-dev/quarto-cli
Path: blob/main/tests/renv/activate.R
6446 views
1
2
local({
3
4
# the requested version of renv
5
version <- "1.1.5"
6
attr(version, "sha") <- NULL
7
8
# the project directory
9
project <- Sys.getenv("RENV_PROJECT")
10
if (!nzchar(project))
11
project <- getwd()
12
13
# use start-up diagnostics if enabled
14
diagnostics <- Sys.getenv("RENV_STARTUP_DIAGNOSTICS", unset = "FALSE")
15
if (diagnostics) {
16
start <- Sys.time()
17
profile <- tempfile("renv-startup-", fileext = ".Rprof")
18
utils::Rprof(profile)
19
on.exit({
20
utils::Rprof(NULL)
21
elapsed <- signif(difftime(Sys.time(), start, units = "auto"), digits = 2L)
22
writeLines(sprintf("- renv took %s to run the autoloader.", format(elapsed)))
23
writeLines(sprintf("- Profile: %s", profile))
24
print(utils::summaryRprof(profile))
25
}, add = TRUE)
26
}
27
28
# figure out whether the autoloader is enabled
29
enabled <- local({
30
31
# first, check config option
32
override <- getOption("renv.config.autoloader.enabled")
33
if (!is.null(override))
34
return(override)
35
36
# if we're being run in a context where R_LIBS is already set,
37
# don't load -- presumably we're being run as a sub-process and
38
# the parent process has already set up library paths for us
39
rcmd <- Sys.getenv("R_CMD", unset = NA)
40
rlibs <- Sys.getenv("R_LIBS", unset = NA)
41
if (!is.na(rlibs) && !is.na(rcmd))
42
return(FALSE)
43
44
# next, check environment variables
45
# prefer using the configuration one in the future
46
envvars <- c(
47
"RENV_CONFIG_AUTOLOADER_ENABLED",
48
"RENV_AUTOLOADER_ENABLED",
49
"RENV_ACTIVATE_PROJECT"
50
)
51
52
for (envvar in envvars) {
53
envval <- Sys.getenv(envvar, unset = NA)
54
if (!is.na(envval))
55
return(tolower(envval) %in% c("true", "t", "1"))
56
}
57
58
# enable by default
59
TRUE
60
61
})
62
63
# bail if we're not enabled
64
if (!enabled) {
65
66
# if we're not enabled, we might still need to manually load
67
# the user profile here
68
profile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile")
69
if (file.exists(profile)) {
70
cfg <- Sys.getenv("RENV_CONFIG_USER_PROFILE", unset = "TRUE")
71
if (tolower(cfg) %in% c("true", "t", "1"))
72
sys.source(profile, envir = globalenv())
73
}
74
75
return(FALSE)
76
77
}
78
79
# avoid recursion
80
if (identical(getOption("renv.autoloader.running"), TRUE)) {
81
warning("ignoring recursive attempt to run renv autoloader")
82
return(invisible(TRUE))
83
}
84
85
# signal that we're loading renv during R startup
86
options(renv.autoloader.running = TRUE)
87
on.exit(options(renv.autoloader.running = NULL), add = TRUE)
88
89
# signal that we've consented to use renv
90
options(renv.consent = TRUE)
91
92
# load the 'utils' package eagerly -- this ensures that renv shims, which
93
# mask 'utils' packages, will come first on the search path
94
library(utils, lib.loc = .Library)
95
96
# unload renv if it's already been loaded
97
if ("renv" %in% loadedNamespaces())
98
unloadNamespace("renv")
99
100
# load bootstrap tools
101
ansify <- function(text) {
102
if (renv_ansify_enabled())
103
renv_ansify_enhanced(text)
104
else
105
renv_ansify_default(text)
106
}
107
108
renv_ansify_enabled <- function() {
109
110
override <- Sys.getenv("RENV_ANSIFY_ENABLED", unset = NA)
111
if (!is.na(override))
112
return(as.logical(override))
113
114
pane <- Sys.getenv("RSTUDIO_CHILD_PROCESS_PANE", unset = NA)
115
if (identical(pane, "build"))
116
return(FALSE)
117
118
testthat <- Sys.getenv("TESTTHAT", unset = "false")
119
if (tolower(testthat) %in% "true")
120
return(FALSE)
121
122
iderun <- Sys.getenv("R_CLI_HAS_HYPERLINK_IDE_RUN", unset = "false")
123
if (tolower(iderun) %in% "false")
124
return(FALSE)
125
126
TRUE
127
128
}
129
130
renv_ansify_default <- function(text) {
131
text
132
}
133
134
renv_ansify_enhanced <- function(text) {
135
136
# R help links
137
pattern <- "`\\?(renv::(?:[^`])+)`"
138
replacement <- "`\033]8;;x-r-help:\\1\a?\\1\033]8;;\a`"
139
text <- gsub(pattern, replacement, text, perl = TRUE)
140
141
# runnable code
142
pattern <- "`(renv::(?:[^`])+)`"
143
replacement <- "`\033]8;;x-r-run:\\1\a\\1\033]8;;\a`"
144
text <- gsub(pattern, replacement, text, perl = TRUE)
145
146
# return ansified text
147
text
148
149
}
150
151
renv_ansify_init <- function() {
152
153
envir <- renv_envir_self()
154
if (renv_ansify_enabled())
155
assign("ansify", renv_ansify_enhanced, envir = envir)
156
else
157
assign("ansify", renv_ansify_default, envir = envir)
158
159
}
160
161
`%||%` <- function(x, y) {
162
if (is.null(x)) y else x
163
}
164
165
catf <- function(fmt, ..., appendLF = TRUE) {
166
167
quiet <- getOption("renv.bootstrap.quiet", default = FALSE)
168
if (quiet)
169
return(invisible())
170
171
msg <- sprintf(fmt, ...)
172
cat(msg, file = stdout(), sep = if (appendLF) "\n" else "")
173
174
invisible(msg)
175
176
}
177
178
header <- function(label,
179
...,
180
prefix = "#",
181
suffix = "-",
182
n = min(getOption("width"), 78))
183
{
184
label <- sprintf(label, ...)
185
n <- max(n - nchar(label) - nchar(prefix) - 2L, 8L)
186
if (n <= 0)
187
return(paste(prefix, label))
188
189
tail <- paste(rep.int(suffix, n), collapse = "")
190
paste0(prefix, " ", label, " ", tail)
191
192
}
193
194
heredoc <- function(text, leave = 0) {
195
196
# remove leading, trailing whitespace
197
trimmed <- gsub("^\\s*\\n|\\n\\s*$", "", text)
198
199
# split into lines
200
lines <- strsplit(trimmed, "\n", fixed = TRUE)[[1L]]
201
202
# compute common indent
203
indent <- regexpr("[^[:space:]]", lines)
204
common <- min(setdiff(indent, -1L)) - leave
205
text <- paste(substring(lines, common), collapse = "\n")
206
207
# substitute in ANSI links for executable renv code
208
ansify(text)
209
210
}
211
212
bootstrap <- function(version, library) {
213
214
friendly <- renv_bootstrap_version_friendly(version)
215
section <- header(sprintf("Bootstrapping renv %s", friendly))
216
catf(section)
217
218
# attempt to download renv
219
catf("- Downloading renv ... ", appendLF = FALSE)
220
withCallingHandlers(
221
tarball <- renv_bootstrap_download(version),
222
error = function(err) {
223
catf("FAILED")
224
stop("failed to download:\n", conditionMessage(err))
225
}
226
)
227
catf("OK")
228
on.exit(unlink(tarball), add = TRUE)
229
230
# now attempt to install
231
catf("- Installing renv ... ", appendLF = FALSE)
232
withCallingHandlers(
233
status <- renv_bootstrap_install(version, tarball, library),
234
error = function(err) {
235
catf("FAILED")
236
stop("failed to install:\n", conditionMessage(err))
237
}
238
)
239
catf("OK")
240
241
# add empty line to break up bootstrapping from normal output
242
catf("")
243
244
return(invisible())
245
}
246
247
renv_bootstrap_tests_running <- function() {
248
getOption("renv.tests.running", default = FALSE)
249
}
250
251
renv_bootstrap_repos <- function() {
252
253
# get CRAN repository
254
cran <- getOption("renv.repos.cran", "https://cloud.r-project.org")
255
256
# check for repos override
257
repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA)
258
if (!is.na(repos)) {
259
260
# check for RSPM; if set, use a fallback repository for renv
261
rspm <- Sys.getenv("RSPM", unset = NA)
262
if (identical(rspm, repos))
263
repos <- c(RSPM = rspm, CRAN = cran)
264
265
return(repos)
266
267
}
268
269
# check for lockfile repositories
270
repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity)
271
if (!inherits(repos, "error") && length(repos))
272
return(repos)
273
274
# retrieve current repos
275
repos <- getOption("repos")
276
277
# ensure @CRAN@ entries are resolved
278
repos[repos == "@CRAN@"] <- cran
279
280
# add in renv.bootstrap.repos if set
281
default <- c(FALLBACK = "https://cloud.r-project.org")
282
extra <- getOption("renv.bootstrap.repos", default = default)
283
repos <- c(repos, extra)
284
285
# remove duplicates that might've snuck in
286
dupes <- duplicated(repos) | duplicated(names(repos))
287
repos[!dupes]
288
289
}
290
291
renv_bootstrap_repos_lockfile <- function() {
292
293
lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock")
294
if (!file.exists(lockpath))
295
return(NULL)
296
297
lockfile <- tryCatch(renv_json_read(lockpath), error = identity)
298
if (inherits(lockfile, "error")) {
299
warning(lockfile)
300
return(NULL)
301
}
302
303
repos <- lockfile$R$Repositories
304
if (length(repos) == 0)
305
return(NULL)
306
307
keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1))
308
vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1))
309
names(vals) <- keys
310
311
return(vals)
312
313
}
314
315
renv_bootstrap_download <- function(version) {
316
317
sha <- attr(version, "sha", exact = TRUE)
318
319
methods <- if (!is.null(sha)) {
320
321
# attempting to bootstrap a development version of renv
322
c(
323
function() renv_bootstrap_download_tarball(sha),
324
function() renv_bootstrap_download_github(sha)
325
)
326
327
} else {
328
329
# attempting to bootstrap a release version of renv
330
c(
331
function() renv_bootstrap_download_tarball(version),
332
function() renv_bootstrap_download_cran_latest(version),
333
function() renv_bootstrap_download_cran_archive(version)
334
)
335
336
}
337
338
for (method in methods) {
339
path <- tryCatch(method(), error = identity)
340
if (is.character(path) && file.exists(path))
341
return(path)
342
}
343
344
stop("All download methods failed")
345
346
}
347
348
renv_bootstrap_download_impl <- function(url, destfile) {
349
350
mode <- "wb"
351
352
# https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17715
353
fixup <-
354
Sys.info()[["sysname"]] == "Windows" &&
355
substring(url, 1L, 5L) == "file:"
356
357
if (fixup)
358
mode <- "w+b"
359
360
args <- list(
361
url = url,
362
destfile = destfile,
363
mode = mode,
364
quiet = TRUE
365
)
366
367
if ("headers" %in% names(formals(utils::download.file))) {
368
headers <- renv_bootstrap_download_custom_headers(url)
369
if (length(headers) && is.character(headers))
370
args$headers <- headers
371
}
372
373
do.call(utils::download.file, args)
374
375
}
376
377
renv_bootstrap_download_custom_headers <- function(url) {
378
379
headers <- getOption("renv.download.headers")
380
if (is.null(headers))
381
return(character())
382
383
if (!is.function(headers))
384
stopf("'renv.download.headers' is not a function")
385
386
headers <- headers(url)
387
if (length(headers) == 0L)
388
return(character())
389
390
if (is.list(headers))
391
headers <- unlist(headers, recursive = FALSE, use.names = TRUE)
392
393
ok <-
394
is.character(headers) &&
395
is.character(names(headers)) &&
396
all(nzchar(names(headers)))
397
398
if (!ok)
399
stop("invocation of 'renv.download.headers' did not return a named character vector")
400
401
headers
402
403
}
404
405
renv_bootstrap_download_cran_latest <- function(version) {
406
407
spec <- renv_bootstrap_download_cran_latest_find(version)
408
type <- spec$type
409
repos <- spec$repos
410
411
baseurl <- utils::contrib.url(repos = repos, type = type)
412
ext <- if (identical(type, "source"))
413
".tar.gz"
414
else if (Sys.info()[["sysname"]] == "Windows")
415
".zip"
416
else
417
".tgz"
418
name <- sprintf("renv_%s%s", version, ext)
419
url <- paste(baseurl, name, sep = "/")
420
421
destfile <- file.path(tempdir(), name)
422
status <- tryCatch(
423
renv_bootstrap_download_impl(url, destfile),
424
condition = identity
425
)
426
427
if (inherits(status, "condition"))
428
return(FALSE)
429
430
# report success and return
431
destfile
432
433
}
434
435
renv_bootstrap_download_cran_latest_find <- function(version) {
436
437
# check whether binaries are supported on this system
438
binary <-
439
getOption("renv.bootstrap.binary", default = TRUE) &&
440
!identical(.Platform$pkgType, "source") &&
441
!identical(getOption("pkgType"), "source") &&
442
Sys.info()[["sysname"]] %in% c("Darwin", "Windows")
443
444
types <- c(if (binary) "binary", "source")
445
446
# iterate over types + repositories
447
for (type in types) {
448
for (repos in renv_bootstrap_repos()) {
449
450
# build arguments for utils::available.packages() call
451
args <- list(type = type, repos = repos)
452
453
# add custom headers if available -- note that
454
# utils::available.packages() will pass this to download.file()
455
if ("headers" %in% names(formals(utils::download.file))) {
456
headers <- renv_bootstrap_download_custom_headers(repos)
457
if (length(headers) && is.character(headers))
458
args$headers <- headers
459
}
460
461
# retrieve package database
462
db <- tryCatch(
463
as.data.frame(
464
do.call(utils::available.packages, args),
465
stringsAsFactors = FALSE
466
),
467
error = identity
468
)
469
470
if (inherits(db, "error"))
471
next
472
473
# check for compatible entry
474
entry <- db[db$Package %in% "renv" & db$Version %in% version, ]
475
if (nrow(entry) == 0)
476
next
477
478
# found it; return spec to caller
479
spec <- list(entry = entry, type = type, repos = repos)
480
return(spec)
481
482
}
483
}
484
485
# if we got here, we failed to find renv
486
fmt <- "renv %s is not available from your declared package repositories"
487
stop(sprintf(fmt, version))
488
489
}
490
491
renv_bootstrap_download_cran_archive <- function(version) {
492
493
name <- sprintf("renv_%s.tar.gz", version)
494
repos <- renv_bootstrap_repos()
495
urls <- file.path(repos, "src/contrib/Archive/renv", name)
496
destfile <- file.path(tempdir(), name)
497
498
for (url in urls) {
499
500
status <- tryCatch(
501
renv_bootstrap_download_impl(url, destfile),
502
condition = identity
503
)
504
505
if (identical(status, 0L))
506
return(destfile)
507
508
}
509
510
return(FALSE)
511
512
}
513
514
renv_bootstrap_download_tarball <- function(version) {
515
516
# if the user has provided the path to a tarball via
517
# an environment variable, then use it
518
tarball <- Sys.getenv("RENV_BOOTSTRAP_TARBALL", unset = NA)
519
if (is.na(tarball))
520
return()
521
522
# allow directories
523
if (dir.exists(tarball)) {
524
name <- sprintf("renv_%s.tar.gz", version)
525
tarball <- file.path(tarball, name)
526
}
527
528
# bail if it doesn't exist
529
if (!file.exists(tarball)) {
530
531
# let the user know we weren't able to honour their request
532
fmt <- "- RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist."
533
msg <- sprintf(fmt, tarball)
534
warning(msg)
535
536
# bail
537
return()
538
539
}
540
541
catf("- Using local tarball '%s'.", tarball)
542
tarball
543
544
}
545
546
renv_bootstrap_github_token <- function() {
547
for (envvar in c("GITHUB_TOKEN", "GITHUB_PAT", "GH_TOKEN")) {
548
envval <- Sys.getenv(envvar, unset = NA)
549
if (!is.na(envval))
550
return(envval)
551
}
552
}
553
554
renv_bootstrap_download_github <- function(version) {
555
556
enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE")
557
if (!identical(enabled, "TRUE"))
558
return(FALSE)
559
560
# prepare download options
561
token <- renv_bootstrap_github_token()
562
if (is.null(token))
563
token <- ""
564
565
if (nzchar(Sys.which("curl")) && nzchar(token)) {
566
fmt <- "--location --fail --header \"Authorization: token %s\""
567
extra <- sprintf(fmt, token)
568
saved <- options("download.file.method", "download.file.extra")
569
options(download.file.method = "curl", download.file.extra = extra)
570
on.exit(do.call(base::options, saved), add = TRUE)
571
} else if (nzchar(Sys.which("wget")) && nzchar(token)) {
572
fmt <- "--header=\"Authorization: token %s\""
573
extra <- sprintf(fmt, token)
574
saved <- options("download.file.method", "download.file.extra")
575
options(download.file.method = "wget", download.file.extra = extra)
576
on.exit(do.call(base::options, saved), add = TRUE)
577
}
578
579
url <- file.path("https://api.github.com/repos/rstudio/renv/tarball", version)
580
name <- sprintf("renv_%s.tar.gz", version)
581
destfile <- file.path(tempdir(), name)
582
583
status <- tryCatch(
584
renv_bootstrap_download_impl(url, destfile),
585
condition = identity
586
)
587
588
if (!identical(status, 0L))
589
return(FALSE)
590
591
renv_bootstrap_download_augment(destfile)
592
593
return(destfile)
594
595
}
596
597
# Add Sha to DESCRIPTION. This is stop gap until #890, after which we
598
# can use renv::install() to fully capture metadata.
599
renv_bootstrap_download_augment <- function(destfile) {
600
sha <- renv_bootstrap_git_extract_sha1_tar(destfile)
601
if (is.null(sha)) {
602
return()
603
}
604
605
# Untar
606
tempdir <- tempfile("renv-github-")
607
on.exit(unlink(tempdir, recursive = TRUE), add = TRUE)
608
untar(destfile, exdir = tempdir)
609
pkgdir <- dir(tempdir, full.names = TRUE)[[1]]
610
611
# Modify description
612
desc_path <- file.path(pkgdir, "DESCRIPTION")
613
desc_lines <- readLines(desc_path)
614
remotes_fields <- c(
615
"RemoteType: github",
616
"RemoteHost: api.github.com",
617
"RemoteRepo: renv",
618
"RemoteUsername: rstudio",
619
"RemotePkgRef: rstudio/renv",
620
paste("RemoteRef: ", sha),
621
paste("RemoteSha: ", sha)
622
)
623
writeLines(c(desc_lines[desc_lines != ""], remotes_fields), con = desc_path)
624
625
# Re-tar
626
local({
627
old <- setwd(tempdir)
628
on.exit(setwd(old), add = TRUE)
629
630
tar(destfile, compression = "gzip")
631
})
632
invisible()
633
}
634
635
# Extract the commit hash from a git archive. Git archives include the SHA1
636
# hash as the comment field of the tarball pax extended header
637
# (see https://www.kernel.org/pub/software/scm/git/docs/git-archive.html)
638
# For GitHub archives this should be the first header after the default one
639
# (512 byte) header.
640
renv_bootstrap_git_extract_sha1_tar <- function(bundle) {
641
642
# open the bundle for reading
643
# We use gzcon for everything because (from ?gzcon)
644
# > Reading from a connection which does not supply a 'gzip' magic
645
# > header is equivalent to reading from the original connection
646
conn <- gzcon(file(bundle, open = "rb", raw = TRUE))
647
on.exit(close(conn))
648
649
# The default pax header is 512 bytes long and the first pax extended header
650
# with the comment should be 51 bytes long
651
# `52 comment=` (11 chars) + 40 byte SHA1 hash
652
len <- 0x200 + 0x33
653
res <- rawToChar(readBin(conn, "raw", n = len)[0x201:len])
654
655
if (grepl("^52 comment=", res)) {
656
sub("52 comment=", "", res)
657
} else {
658
NULL
659
}
660
}
661
662
renv_bootstrap_install <- function(version, tarball, library) {
663
664
# attempt to install it into project library
665
dir.create(library, showWarnings = FALSE, recursive = TRUE)
666
output <- renv_bootstrap_install_impl(library, tarball)
667
668
# check for successful install
669
status <- attr(output, "status")
670
if (is.null(status) || identical(status, 0L))
671
return(status)
672
673
# an error occurred; report it
674
header <- "installation of renv failed"
675
lines <- paste(rep.int("=", nchar(header)), collapse = "")
676
text <- paste(c(header, lines, output), collapse = "\n")
677
stop(text)
678
679
}
680
681
renv_bootstrap_install_impl <- function(library, tarball) {
682
683
# invoke using system2 so we can capture and report output
684
bin <- R.home("bin")
685
exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R"
686
R <- file.path(bin, exe)
687
688
args <- c(
689
"--vanilla", "CMD", "INSTALL", "--no-multiarch",
690
"-l", shQuote(path.expand(library)),
691
shQuote(path.expand(tarball))
692
)
693
694
system2(R, args, stdout = TRUE, stderr = TRUE)
695
696
}
697
698
renv_bootstrap_platform_prefix_default <- function() {
699
700
# read version component
701
version <- Sys.getenv("RENV_PATHS_VERSION", unset = "R-%v")
702
703
# expand placeholders
704
placeholders <- list(
705
list("%v", format(getRversion()[1, 1:2])),
706
list("%V", format(getRversion()[1, 1:3]))
707
)
708
709
for (placeholder in placeholders)
710
version <- gsub(placeholder[[1L]], placeholder[[2L]], version, fixed = TRUE)
711
712
# include SVN revision for development versions of R
713
# (to avoid sharing platform-specific artefacts with released versions of R)
714
devel <-
715
identical(R.version[["status"]], "Under development (unstable)") ||
716
identical(R.version[["nickname"]], "Unsuffered Consequences")
717
718
if (devel)
719
version <- paste(version, R.version[["svn rev"]], sep = "-r")
720
721
version
722
723
}
724
725
renv_bootstrap_platform_prefix <- function() {
726
727
# construct version prefix
728
version <- renv_bootstrap_platform_prefix_default()
729
730
# build list of path components
731
components <- c(version, R.version$platform)
732
733
# include prefix if provided by user
734
prefix <- renv_bootstrap_platform_prefix_impl()
735
if (!is.na(prefix) && nzchar(prefix))
736
components <- c(prefix, components)
737
738
# build prefix
739
paste(components, collapse = "/")
740
741
}
742
743
renv_bootstrap_platform_prefix_impl <- function() {
744
745
# if an explicit prefix has been supplied, use it
746
prefix <- Sys.getenv("RENV_PATHS_PREFIX", unset = NA)
747
if (!is.na(prefix))
748
return(prefix)
749
750
# if the user has requested an automatic prefix, generate it
751
auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA)
752
if (is.na(auto) && getRversion() >= "4.4.0")
753
auto <- "TRUE"
754
755
if (auto %in% c("TRUE", "True", "true", "1"))
756
return(renv_bootstrap_platform_prefix_auto())
757
758
# empty string on failure
759
""
760
761
}
762
763
renv_bootstrap_platform_prefix_auto <- function() {
764
765
prefix <- tryCatch(renv_bootstrap_platform_os(), error = identity)
766
if (inherits(prefix, "error") || prefix %in% "unknown") {
767
768
msg <- paste(
769
"failed to infer current operating system",
770
"please file a bug report at https://github.com/rstudio/renv/issues",
771
sep = "; "
772
)
773
774
warning(msg)
775
776
}
777
778
prefix
779
780
}
781
782
renv_bootstrap_platform_os <- function() {
783
784
sysinfo <- Sys.info()
785
sysname <- sysinfo[["sysname"]]
786
787
# handle Windows + macOS up front
788
if (sysname == "Windows")
789
return("windows")
790
else if (sysname == "Darwin")
791
return("macos")
792
793
# check for os-release files
794
for (file in c("/etc/os-release", "/usr/lib/os-release"))
795
if (file.exists(file))
796
return(renv_bootstrap_platform_os_via_os_release(file, sysinfo))
797
798
# check for redhat-release files
799
if (file.exists("/etc/redhat-release"))
800
return(renv_bootstrap_platform_os_via_redhat_release())
801
802
"unknown"
803
804
}
805
806
renv_bootstrap_platform_os_via_os_release <- function(file, sysinfo) {
807
808
# read /etc/os-release
809
release <- utils::read.table(
810
file = file,
811
sep = "=",
812
quote = c("\"", "'"),
813
col.names = c("Key", "Value"),
814
comment.char = "#",
815
stringsAsFactors = FALSE
816
)
817
818
vars <- as.list(release$Value)
819
names(vars) <- release$Key
820
821
# get os name
822
os <- tolower(sysinfo[["sysname"]])
823
824
# read id
825
id <- "unknown"
826
for (field in c("ID", "ID_LIKE")) {
827
if (field %in% names(vars) && nzchar(vars[[field]])) {
828
id <- vars[[field]]
829
break
830
}
831
}
832
833
# read version
834
version <- "unknown"
835
for (field in c("UBUNTU_CODENAME", "VERSION_CODENAME", "VERSION_ID", "BUILD_ID")) {
836
if (field %in% names(vars) && nzchar(vars[[field]])) {
837
version <- vars[[field]]
838
break
839
}
840
}
841
842
# join together
843
paste(c(os, id, version), collapse = "-")
844
845
}
846
847
renv_bootstrap_platform_os_via_redhat_release <- function() {
848
849
# read /etc/redhat-release
850
contents <- readLines("/etc/redhat-release", warn = FALSE)
851
852
# infer id
853
id <- if (grepl("centos", contents, ignore.case = TRUE))
854
"centos"
855
else if (grepl("redhat", contents, ignore.case = TRUE))
856
"redhat"
857
else
858
"unknown"
859
860
# try to find a version component (very hacky)
861
version <- "unknown"
862
863
parts <- strsplit(contents, "[[:space:]]")[[1L]]
864
for (part in parts) {
865
866
nv <- tryCatch(numeric_version(part), error = identity)
867
if (inherits(nv, "error"))
868
next
869
870
version <- nv[1, 1]
871
break
872
873
}
874
875
paste(c("linux", id, version), collapse = "-")
876
877
}
878
879
renv_bootstrap_library_root_name <- function(project) {
880
881
# use project name as-is if requested
882
asis <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT_ASIS", unset = "FALSE")
883
if (asis)
884
return(basename(project))
885
886
# otherwise, disambiguate based on project's path
887
id <- substring(renv_bootstrap_hash_text(project), 1L, 8L)
888
paste(basename(project), id, sep = "-")
889
890
}
891
892
renv_bootstrap_library_root <- function(project) {
893
894
prefix <- renv_bootstrap_profile_prefix()
895
896
path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA)
897
if (!is.na(path))
898
return(paste(c(path, prefix), collapse = "/"))
899
900
path <- renv_bootstrap_library_root_impl(project)
901
if (!is.null(path)) {
902
name <- renv_bootstrap_library_root_name(project)
903
return(paste(c(path, prefix, name), collapse = "/"))
904
}
905
906
renv_bootstrap_paths_renv("library", project = project)
907
908
}
909
910
renv_bootstrap_library_root_impl <- function(project) {
911
912
root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA)
913
if (!is.na(root))
914
return(root)
915
916
type <- renv_bootstrap_project_type(project)
917
if (identical(type, "package")) {
918
userdir <- renv_bootstrap_user_dir()
919
return(file.path(userdir, "library"))
920
}
921
922
}
923
924
renv_bootstrap_validate_version <- function(version, description = NULL) {
925
926
# resolve description file
927
#
928
# avoid passing lib.loc to `packageDescription()` below, since R will
929
# use the loaded version of the package by default anyhow. note that
930
# this function should only be called after 'renv' is loaded
931
# https://github.com/rstudio/renv/issues/1625
932
description <- description %||% packageDescription("renv")
933
934
# check whether requested version 'version' matches loaded version of renv
935
sha <- attr(version, "sha", exact = TRUE)
936
valid <- if (!is.null(sha))
937
renv_bootstrap_validate_version_dev(sha, description)
938
else
939
renv_bootstrap_validate_version_release(version, description)
940
941
if (valid)
942
return(TRUE)
943
944
# the loaded version of renv doesn't match the requested version;
945
# give the user instructions on how to proceed
946
dev <- identical(description[["RemoteType"]], "github")
947
remote <- if (dev)
948
paste("rstudio/renv", description[["RemoteSha"]], sep = "@")
949
else
950
paste("renv", description[["Version"]], sep = "@")
951
952
# display both loaded version + sha if available
953
friendly <- renv_bootstrap_version_friendly(
954
version = description[["Version"]],
955
sha = if (dev) description[["RemoteSha"]]
956
)
957
958
fmt <- heredoc("
959
renv %1$s was loaded from project library, but this project is configured to use renv %2$s.
960
- Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile.
961
- Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.
962
")
963
catf(fmt, friendly, renv_bootstrap_version_friendly(version), remote)
964
965
FALSE
966
967
}
968
969
renv_bootstrap_validate_version_dev <- function(version, description) {
970
971
expected <- description[["RemoteSha"]]
972
if (!is.character(expected))
973
return(FALSE)
974
975
pattern <- sprintf("^\\Q%s\\E", version)
976
grepl(pattern, expected, perl = TRUE)
977
978
}
979
980
renv_bootstrap_validate_version_release <- function(version, description) {
981
expected <- description[["Version"]]
982
is.character(expected) && identical(expected, version)
983
}
984
985
renv_bootstrap_hash_text <- function(text) {
986
987
hashfile <- tempfile("renv-hash-")
988
on.exit(unlink(hashfile), add = TRUE)
989
990
writeLines(text, con = hashfile)
991
tools::md5sum(hashfile)
992
993
}
994
995
renv_bootstrap_load <- function(project, libpath, version) {
996
997
# try to load renv from the project library
998
if (!requireNamespace("renv", lib.loc = libpath, quietly = TRUE))
999
return(FALSE)
1000
1001
# warn if the version of renv loaded does not match
1002
renv_bootstrap_validate_version(version)
1003
1004
# execute renv load hooks, if any
1005
hooks <- getHook("renv::autoload")
1006
for (hook in hooks)
1007
if (is.function(hook))
1008
tryCatch(hook(), error = warnify)
1009
1010
# load the project
1011
renv::load(project)
1012
1013
TRUE
1014
1015
}
1016
1017
renv_bootstrap_profile_load <- function(project) {
1018
1019
# if RENV_PROFILE is already set, just use that
1020
profile <- Sys.getenv("RENV_PROFILE", unset = NA)
1021
if (!is.na(profile) && nzchar(profile))
1022
return(profile)
1023
1024
# check for a profile file (nothing to do if it doesn't exist)
1025
path <- renv_bootstrap_paths_renv("profile", profile = FALSE, project = project)
1026
if (!file.exists(path))
1027
return(NULL)
1028
1029
# read the profile, and set it if it exists
1030
contents <- readLines(path, warn = FALSE)
1031
if (length(contents) == 0L)
1032
return(NULL)
1033
1034
# set RENV_PROFILE
1035
profile <- contents[[1L]]
1036
if (!profile %in% c("", "default"))
1037
Sys.setenv(RENV_PROFILE = profile)
1038
1039
profile
1040
1041
}
1042
1043
renv_bootstrap_profile_prefix <- function() {
1044
profile <- renv_bootstrap_profile_get()
1045
if (!is.null(profile))
1046
return(file.path("profiles", profile, "renv"))
1047
}
1048
1049
renv_bootstrap_profile_get <- function() {
1050
profile <- Sys.getenv("RENV_PROFILE", unset = "")
1051
renv_bootstrap_profile_normalize(profile)
1052
}
1053
1054
renv_bootstrap_profile_set <- function(profile) {
1055
profile <- renv_bootstrap_profile_normalize(profile)
1056
if (is.null(profile))
1057
Sys.unsetenv("RENV_PROFILE")
1058
else
1059
Sys.setenv(RENV_PROFILE = profile)
1060
}
1061
1062
renv_bootstrap_profile_normalize <- function(profile) {
1063
1064
if (is.null(profile) || profile %in% c("", "default"))
1065
return(NULL)
1066
1067
profile
1068
1069
}
1070
1071
renv_bootstrap_path_absolute <- function(path) {
1072
1073
substr(path, 1L, 1L) %in% c("~", "/", "\\") || (
1074
substr(path, 1L, 1L) %in% c(letters, LETTERS) &&
1075
substr(path, 2L, 3L) %in% c(":/", ":\\")
1076
)
1077
1078
}
1079
1080
renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) {
1081
renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv")
1082
root <- if (renv_bootstrap_path_absolute(renv)) NULL else project
1083
prefix <- if (profile) renv_bootstrap_profile_prefix()
1084
components <- c(root, renv, prefix, ...)
1085
paste(components, collapse = "/")
1086
}
1087
1088
renv_bootstrap_project_type <- function(path) {
1089
1090
descpath <- file.path(path, "DESCRIPTION")
1091
if (!file.exists(descpath))
1092
return("unknown")
1093
1094
desc <- tryCatch(
1095
read.dcf(descpath, all = TRUE),
1096
error = identity
1097
)
1098
1099
if (inherits(desc, "error"))
1100
return("unknown")
1101
1102
type <- desc$Type
1103
if (!is.null(type))
1104
return(tolower(type))
1105
1106
package <- desc$Package
1107
if (!is.null(package))
1108
return("package")
1109
1110
"unknown"
1111
1112
}
1113
1114
renv_bootstrap_user_dir <- function() {
1115
dir <- renv_bootstrap_user_dir_impl()
1116
path.expand(chartr("\\", "/", dir))
1117
}
1118
1119
renv_bootstrap_user_dir_impl <- function() {
1120
1121
# use local override if set
1122
override <- getOption("renv.userdir.override")
1123
if (!is.null(override))
1124
return(override)
1125
1126
# use R_user_dir if available
1127
tools <- asNamespace("tools")
1128
if (is.function(tools$R_user_dir))
1129
return(tools$R_user_dir("renv", "cache"))
1130
1131
# try using our own backfill for older versions of R
1132
envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME")
1133
for (envvar in envvars) {
1134
root <- Sys.getenv(envvar, unset = NA)
1135
if (!is.na(root))
1136
return(file.path(root, "R/renv"))
1137
}
1138
1139
# use platform-specific default fallbacks
1140
if (Sys.info()[["sysname"]] == "Windows")
1141
file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv")
1142
else if (Sys.info()[["sysname"]] == "Darwin")
1143
"~/Library/Caches/org.R-project.R/R/renv"
1144
else
1145
"~/.cache/R/renv"
1146
1147
}
1148
1149
renv_bootstrap_version_friendly <- function(version, shafmt = NULL, sha = NULL) {
1150
sha <- sha %||% attr(version, "sha", exact = TRUE)
1151
parts <- c(version, sprintf(shafmt %||% " [sha: %s]", substring(sha, 1L, 7L)))
1152
paste(parts, collapse = "")
1153
}
1154
1155
renv_bootstrap_exec <- function(project, libpath, version) {
1156
if (!renv_bootstrap_load(project, libpath, version))
1157
renv_bootstrap_run(project, libpath, version)
1158
}
1159
1160
renv_bootstrap_run <- function(project, libpath, version) {
1161
1162
# perform bootstrap
1163
bootstrap(version, libpath)
1164
1165
# exit early if we're just testing bootstrap
1166
if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA)))
1167
return(TRUE)
1168
1169
# try again to load
1170
if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) {
1171
return(renv::load(project = project))
1172
}
1173
1174
# failed to download or load renv; warn the user
1175
msg <- c(
1176
"Failed to find an renv installation: the project will not be loaded.",
1177
"Use `renv::activate()` to re-initialize the project."
1178
)
1179
1180
warning(paste(msg, collapse = "\n"), call. = FALSE)
1181
1182
}
1183
1184
renv_json_read <- function(file = NULL, text = NULL) {
1185
1186
jlerr <- NULL
1187
1188
# if jsonlite is loaded, use that instead
1189
if ("jsonlite" %in% loadedNamespaces()) {
1190
1191
json <- tryCatch(renv_json_read_jsonlite(file, text), error = identity)
1192
if (!inherits(json, "error"))
1193
return(json)
1194
1195
jlerr <- json
1196
1197
}
1198
1199
# otherwise, fall back to the default JSON reader
1200
json <- tryCatch(renv_json_read_default(file, text), error = identity)
1201
if (!inherits(json, "error"))
1202
return(json)
1203
1204
# report an error
1205
if (!is.null(jlerr))
1206
stop(jlerr)
1207
else
1208
stop(json)
1209
1210
}
1211
1212
renv_json_read_jsonlite <- function(file = NULL, text = NULL) {
1213
text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
1214
jsonlite::fromJSON(txt = text, simplifyVector = FALSE)
1215
}
1216
1217
renv_json_read_patterns <- function() {
1218
1219
list(
1220
1221
# objects
1222
list("{", "\t\n\tobject(\t\n\t", TRUE),
1223
list("}", "\t\n\t)\t\n\t", TRUE),
1224
1225
# arrays
1226
list("[", "\t\n\tarray(\t\n\t", TRUE),
1227
list("]", "\n\t\n)\n\t\n", TRUE),
1228
1229
# maps
1230
list(":", "\t\n\t=\t\n\t", TRUE),
1231
1232
# newlines
1233
list("\\u000a", "\n", FALSE)
1234
1235
)
1236
1237
}
1238
1239
renv_json_read_envir <- function() {
1240
1241
envir <- new.env(parent = emptyenv())
1242
1243
envir[["+"]] <- `+`
1244
envir[["-"]] <- `-`
1245
1246
envir[["object"]] <- function(...) {
1247
result <- list(...)
1248
names(result) <- as.character(names(result))
1249
result
1250
}
1251
1252
envir[["array"]] <- list
1253
1254
envir[["true"]] <- TRUE
1255
envir[["false"]] <- FALSE
1256
envir[["null"]] <- NULL
1257
1258
envir
1259
1260
}
1261
1262
renv_json_read_remap <- function(object, patterns) {
1263
1264
# repair names if necessary
1265
if (!is.null(names(object))) {
1266
1267
nms <- names(object)
1268
for (pattern in patterns)
1269
nms <- gsub(pattern[[2L]], pattern[[1L]], nms, fixed = TRUE)
1270
names(object) <- nms
1271
1272
}
1273
1274
# repair strings if necessary
1275
if (is.character(object)) {
1276
for (pattern in patterns)
1277
object <- gsub(pattern[[2L]], pattern[[1L]], object, fixed = TRUE)
1278
}
1279
1280
# recurse for other objects
1281
if (is.recursive(object))
1282
for (i in seq_along(object))
1283
object[i] <- list(renv_json_read_remap(object[[i]], patterns))
1284
1285
# return remapped object
1286
object
1287
1288
}
1289
1290
renv_json_read_default <- function(file = NULL, text = NULL) {
1291
1292
# read json text
1293
text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
1294
1295
# convert into something the R parser will understand
1296
patterns <- renv_json_read_patterns()
1297
transformed <- text
1298
for (pattern in patterns)
1299
transformed <- gsub(pattern[[1L]], pattern[[2L]], transformed, fixed = TRUE)
1300
1301
# parse it
1302
rfile <- tempfile("renv-json-", fileext = ".R")
1303
on.exit(unlink(rfile), add = TRUE)
1304
writeLines(transformed, con = rfile)
1305
json <- parse(rfile, keep.source = FALSE, srcfile = NULL)[[1L]]
1306
1307
# evaluate in safe environment
1308
result <- eval(json, envir = renv_json_read_envir())
1309
1310
# fix up strings if necessary -- do so only with reversible patterns
1311
patterns <- Filter(function(pattern) pattern[[3L]], patterns)
1312
renv_json_read_remap(result, patterns)
1313
1314
}
1315
1316
1317
# load the renv profile, if any
1318
renv_bootstrap_profile_load(project)
1319
1320
# construct path to library root
1321
root <- renv_bootstrap_library_root(project)
1322
1323
# construct library prefix for platform
1324
prefix <- renv_bootstrap_platform_prefix()
1325
1326
# construct full libpath
1327
libpath <- file.path(root, prefix)
1328
1329
# run bootstrap code
1330
renv_bootstrap_exec(project, libpath, version)
1331
1332
invisible()
1333
1334
})
1335
1336