1# File src/library/utils/R/packages2.R 2# Part of the R package, https://www.R-project.org 3# 4# Copyright (C) 1995-2020 The R Core Team 5# 6# This program is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License as published by 8# the Free Software Foundation; either version 2 of the License, or 9# (at your option) any later version. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16# A copy of the GNU General Public License is available at 17# https://www.R-project.org/Licenses/ 18 19if (.Platform$OS.type == "windows") 20 .install.macbinary <- function(...) NULL # globalVariables isn't available, so use this to suppress the warning 21 22isBasePkg <- function(pkg) { 23 priority <- tryCatch(packageDescription(pkg, fields = "Priority"), 24 error = function(e) e, warning = function(e) e) 25 identical(priority, "base") 26} 27 28getDependencies <- 29 function(pkgs, dependencies = NA, available = NULL, lib = .libPaths()[1L], 30 binary = FALSE, ..., av2 = NULL) ## ... is passed to installed.packages(). 31{ 32 if (is.null(dependencies)) return(unique(pkgs)) 33 oneLib <- length(lib) == 1L 34 dep2 <- NULL 35 if(is.logical(dependencies) && is.na(dependencies)) 36 dependencies <- c("Depends", "Imports", "LinkingTo") 37 depends <- 38 is.character(dependencies) || (is.logical(dependencies) && dependencies) 39 if(depends && is.logical(dependencies)) { 40 if(binary) { 41 dependencies <- c("Depends", "Imports", "Suggests") 42 dep2 <- c("Depends", "Imports") 43 } else { 44 dependencies <- c("Depends", "Imports", "LinkingTo", "Suggests") 45 dep2 <- c("Depends", "Imports", "LinkingTo") 46 } 47 } 48 if(depends && !oneLib) { 49 warning("Do not know which element of 'lib' to install dependencies into\nskipping dependencies") 50 depends <- FALSE 51 } 52 p0 <- unique(pkgs) 53 miss <- !p0 %in% row.names(available) 54 base <- vapply(p0, isBasePkg, FALSE) 55 if (sum(base)) 56 warning(sprintf(ngettext(sum(base), 57 "package %s is a base package, and should not be updated", 58 "packages %s are base packages, and should not be updated"), 59 paste(sQuote(p0[base]), collapse = ", ")), 60 domain = NA, call. = FALSE) 61 m0 <- miss & !base 62 msg2 <- NULL 63 if(sum(m0) && !is.null(av2)) { 64 keep <- rownames(av2) %in% p0[m0] ## there might be duplicate matches 65 av2 <- av2[keep, , drop = FALSE] 66 if(nrow(av2)) { 67 ds <- av2[, "Depends"] 68 ds[is.na(ds)] <- "" 69 x <- lapply(strsplit(sub("^[[:space:]]*", "", ds), 70 "[[:space:]]*,[[:space:]]*"), 71 function(s) s[grepl("^R[[:space:]]*\\(", s)]) 72 lens <- lengths(x) 73 pos <- which(lens > 0L) 74 av2 <- av2[pos,, drop = FALSE]; x <- x[pos] 75 msg2 <- paste(sQuote(av2[, "Package"]), "version", av2[, "Version"], 76 "is in the repositories but depends on", unlist(x)) 77 } 78 } 79 if(sum(m0)) { 80 msg <- paste0(if(binary) "as a binary package ", 81 "for this version of R") 82 msg3 <- c(paste0(ngettext(sum(m0), 83 "A version of this package for your version of R might be available elsewhere,\nsee the ideas at\n", 84 "Versions of these packages for your version of R might be available elsewhere,\nsee the ideas at\n"), 85 ## refer to r-patched for released/patched versions 86 if (grepl("Under development", R.version.string)) { 87 "https://cran.r-project.org/doc/manuals/r-devel/R-admin.html#Installing-packages" 88 } else { 89 "https://cran.r-project.org/doc/manuals/r-patched/R-admin.html#Installing-packages" 90 }) 91 ) 92 warning(sprintf(ngettext(sum(m0), 93 "package %s is not available %s", 94 "packages %s are not available %s"), 95 paste(sQuote(p0[m0]), collapse = ", "), 96 paste(c(msg, msg2, "", msg3), collapse = "\n")), 97 domain = NA, call. = FALSE) 98 if (sum(m0) == 1L && 99 !is.na(w <- match(tolower(p0[m0]), 100 tolower(row.names(available))))) { 101 warning(sprintf("Perhaps you meant %s ?", 102 sQuote(row.names(available)[w])), 103 call. = FALSE, domain = NA) 104 } 105 flush.console() 106 } 107 p0 <- p0[!miss] 108 109 if(depends && length(p0)) { # check for dependencies, recursively 110 p1 <- p0 # this is ok, as 1 lib only 111 ## INSTALL prepends 'lib' to the libpath 112 ## Here we are slightly more conservative 113 libpath <- .libPaths() 114 if(!lib %in% libpath) libpath <- c(lib, libpath) 115 installed <- installed.packages(lib.loc = libpath, 116 fields = c("Package", "Version"), 117 ...) 118 not_avail <- character() 119 repeat { 120 deps <- apply(available[p1, dependencies, drop = FALSE], 121 1L, function(x) paste(x[!is.na(x)], collapse=", ")) 122 res <- .clean_up_dependencies2(deps, installed, available) 123 not_avail <- c(not_avail, res[[2L]]) 124 deps <- unique(res[[1L]]) 125 ## R should not get to here, but be safe 126 deps <- deps[!deps %in% c("R", pkgs)] 127 if(!length(deps)) break 128 pkgs <- c(deps, pkgs) 129 p1 <- deps 130 if(!is.null(dep2)) { dependencies <- dep2; dep2 <- NULL } 131 } 132 if(length(not_avail)) { 133 not_avail <- unique(not_avail) 134 warning(sprintf(ngettext(length(not_avail), 135 "dependency %s is not available", 136 "dependencies %s are not available"), 137 paste(sQuote(not_avail), collapse=", ")), 138 domain = NA, call. = FALSE, immediate. = TRUE) 139 flush.console() 140 } 141 142 pkgs <- unique(pkgs) 143 pkgs <- pkgs[pkgs %in% row.names(available)] 144 if(length(pkgs) > length(p0)) { 145 added <- setdiff(pkgs, p0) 146 message(sprintf(ngettext(length(added), 147 "also installing the dependency %s", 148 "also installing the dependencies %s"), 149 paste(sQuote(added), collapse=", ")), 150 "\n", domain = NA) 151 flush.console() 152 } 153 p0 <- pkgs 154 } 155 p0 156} 157 158install.packages <- 159 function(pkgs, lib, repos = getOption("repos"), 160 contriburl = contrib.url(repos, type), 161 method, available = NULL, destdir = NULL, dependencies = NA, 162 type = getOption("pkgType"), 163 configure.args = getOption("configure.args"), 164 configure.vars = getOption("configure.vars"), 165 clean = FALSE, Ncpus = getOption("Ncpus", 1L), 166 verbose = getOption("verbose"), 167 libs_only = FALSE, INSTALL_opts, quiet = FALSE, 168 keep_outputs = FALSE, 169 ...) 170{ 171 if (!is.character(type)) 172 stop("invalid 'type'; must be a character string") 173 type2 <- .Platform$pkgType 174 if (type == "binary") { 175 if (type2 == "source") 176 stop("type 'binary' is not supported on this platform") 177 else type <- type2 178 if(type == "both" && (!missing(contriburl) || !is.null(available))) 179 stop("specifying 'contriburl' or 'available' requires a single type, not type = \"both\"") 180 } 181 if (is.logical(clean) && clean) 182 clean <- "--clean" 183 if(is.logical(dependencies) && is.na(dependencies)) 184 dependencies <- if(!missing(lib) && length(lib) > 1L) FALSE 185 else c("Depends", "Imports", "LinkingTo") 186 187 ## Compute the configuration arguments for a given package. 188 ## If configure.args is an unnamed character vector, use that. 189 ## If it is named, match the pkg name to the names of the character 190 ## vector and if we get a match, use that element. 191 ## Similarly, configure.args is a list(), match pkg to the names pkg 192 ## and use that element, collapsing it into a single string. 193 194 get_package_name <- function(pkg) { 195 ## Since the pkg argument can be the name of a file rather than 196 ## a regular package name, we have to clean that up. 197 gsub("_[.](zip|tar[.]gz|tar[.]bzip2|tar[.]xz)", "", 198 gsub(.standard_regexps()$valid_package_version, "", 199 basename(pkg))) 200 } 201 202 getConfigureArgs <- function(pkg) 203 { 204 if(.Platform$OS.type == "windows") return(character()) 205 206 if(length(pkgs) == 1L && length(configure.args) && 207 length(names(configure.args)) == 0L) 208 return(paste0("--configure-args=", 209 shQuote(paste(configure.args, collapse = " ")))) 210 211 pkg <- get_package_name(pkg) 212 if (length(configure.args) && length(names(configure.args)) 213 && pkg %in% names(configure.args)) 214 config <- paste0("--configure-args=", 215 shQuote(paste(configure.args[[ pkg ]], collapse = " "))) 216 else 217 config <- character() 218 219 config 220 } 221 222 getConfigureVars <- function(pkg) 223 { 224 if(.Platform$OS.type == "windows") return(character()) 225 226 if(length(pkgs) == 1L && length(configure.vars) && 227 length(names(configure.vars)) == 0L) 228 return(paste0("--configure-vars=", 229 shQuote(paste(configure.vars, collapse = " ")))) 230 231 pkg <- get_package_name(pkg) 232 if (length(configure.vars) && length(names(configure.vars)) 233 && pkg %in% names(configure.vars)) 234 config <- paste0("--configure-vars=", 235 shQuote(paste(configure.vars[[ pkg ]], collapse = " "))) 236 else 237 config <- character() 238 239 config 240 } 241 242 get_install_opts <- function(pkg) { 243 if(!length(INSTALL_opts)) 244 character() 245 else 246 paste(INSTALL_opts[[get_package_name(pkg)]], collapse = " ") 247 } 248 249 if(missing(pkgs)) { 250 if(!interactive()) stop("no packages were specified") 251 ## if no packages were specified, use a menu 252 if(.Platform$OS.type == "windows" || .Platform$GUI == "AQUA" 253 || (capabilities("tcltk") 254 && capabilities("X11") && suppressWarnings(tcltk::.TkUp)) ) { 255 ## this is the condition for a graphical select.list() 256 } else 257 stop("no packages were specified") 258 259 ## This will only offer the specified type. If type = "both" 260 ## do not want 'available' set for "source". 261 if(is.null(available)) { 262 av <- available.packages(contriburl = contriburl, method = method, 263 ...) 264 if (missing(repos)) ## Evaluating contriburl may have changed repos, which may be used below 265 repos <- getOption("repos") 266 if(type != "both") available <- av 267 } else av <- available 268 if(NROW(av)) { 269 ## avoid duplicate entries in menus, since the latest available 270 ## will be picked up 271 ## sort in the locale, as R <= 2.10.1 did so 272 pkgs <- select.list(sort(unique(rownames(av))), 273 multiple = TRUE, 274 title = "Packages", graphics = TRUE) 275 } 276 } 277 278 if (.Platform$OS.type == "windows" && length(pkgs)) { 279 ## look for package in use. 280 pkgnames <- get_package_name(pkgs) 281 ## there is no guarantee we have got the package name right: 282 ## foo.zip might contain package bar or Foo or FOO or .... 283 ## but we can't tell without trying to unpack it. 284 inuse <- search() 285 inuse <- sub("^package:", "", inuse[grep("^package:", inuse)]) 286 inuse <- pkgnames %in% inuse 287 if(any(inuse)) { 288 warning(sprintf(ngettext(sum(inuse), 289 "package %s is in use and will not be installed", 290 "packages %s are in use and will not be installed"), 291 paste(sQuote(pkgnames[inuse]), collapse=", ")), 292 call. = FALSE, domain = NA, immediate. = TRUE) 293 pkgs <- pkgs[!inuse] 294 } 295 } 296 297 if(!length(pkgs)) return(invisible()) 298 299 if(missing(lib) || is.null(lib)) { 300 lib <- .libPaths()[1L] 301 if(!quiet && length(.libPaths()) > 1L) 302 message(sprintf(ngettext(length(pkgs), 303 "Installing package into %s\n(as %s is unspecified)", 304 "Installing packages into %s\n(as %s is unspecified)"), 305 sQuote(lib), sQuote("lib")), domain = NA) 306 } 307 308 ## check for writability by user 309 ok <- dir.exists(lib) & (file.access(lib, 2) == 0L) 310 if(length(lib) > 1 && any(!ok)) 311 stop(sprintf(ngettext(sum(!ok), 312 "'lib' element %s is not a writable directory", 313 "'lib' elements %s are not writable directories"), 314 paste(sQuote(lib[!ok]), collapse=", ")), domain = NA) 315 if(length(lib) == 1L && .Platform$OS.type == "windows") { 316 ## file.access is unreliable on Windows, especially >= Vista. 317 ## the only known reliable way is to try it 318 ok <- dir.exists(lib) # dir might not exist, PR#14311 319 if(ok) { 320 fn <- file.path(lib, paste0("_test_dir_", Sys.getpid())) 321 unlink(fn, recursive = TRUE) # precaution 322 res <- try(dir.create(fn, showWarnings = FALSE)) 323 if(inherits(res, "try-error") || !res) ok <- FALSE 324 else unlink(fn, recursive = TRUE) 325 } 326 } 327 if(length(lib) == 1L && !ok) { 328 warning(gettextf("'lib = \"%s\"' is not writable", lib), 329 domain = NA, immediate. = TRUE) 330 userdir <- unlist(strsplit(Sys.getenv("R_LIBS_USER"), 331 .Platform$path.sep))[1L] 332 if(interactive()) { 333 ans <- askYesNo(gettext("Would you like to use a personal library instead?"), default = FALSE) 334 if(!isTRUE(ans)) stop("unable to install packages") 335 336 lib <- userdir 337 if(!file.exists(userdir)) { 338 ans <- askYesNo(gettextf("Would you like to create a personal library\n%s\nto install packages into?", 339 sQuote(userdir)), default = FALSE) 340 if(!isTRUE(ans)) stop("unable to install packages") 341 if(!dir.create(userdir, recursive = TRUE)) 342 stop(gettextf("unable to create %s", sQuote(userdir)), 343 domain = NA) 344 .libPaths(c(userdir, .libPaths())) 345 } 346 } else stop("unable to install packages") 347 } 348 349 lib <- normalizePath(lib) 350 351 ## check if we should infer repos = NULL 352 if(length(pkgs) == 1L && missing(repos) && missing(contriburl)) { 353 if((type == "source" && any(grepl("[.]tar[.](gz|bz2|xz)$", pkgs))) || 354 (type %in% "win.binary" && endsWith(pkgs, ".zip")) || 355 (startsWith(type, "mac.binary") && endsWith(pkgs, ".tgz"))) { 356 repos <- NULL 357 message("inferring 'repos = NULL' from 'pkgs'") 358 } 359 if (type == "both") { 360 if (type2 %in% "win.binary" && endsWith(pkgs, ".zip")) { 361 repos <- NULL 362 type <- type2 363 message("inferring 'repos = NULL' from 'pkgs'") 364 } else if (startsWith(type2, "mac.binary") 365 && endsWith(pkgs, ".tgz")) { 366 repos <- NULL 367 type <- type2 368 message("inferring 'repos = NULL' from 'pkgs'") 369 } else if (grepl("[.]tar[.](gz|bz2|xz)$", pkgs)) { 370 repos <- NULL 371 type <- "source" 372 message("inferring 'repos = NULL' from 'pkgs'") 373 } 374 } 375 } 376 377 ## check if we should infer the type 378 if (length(pkgs) == 1L && is.null(repos) && type == "both") { 379 if ( (type2 %in% "win.binary" && endsWith(pkgs, ".zip")) 380 ||(startsWith(type2, "mac.binary") 381 && endsWith(pkgs, ".tgz"))) { 382 type <- type2 383 } else if (grepl("[.]tar[.](gz|bz2|xz)$", pkgs)) { 384 type <- "source" 385 } 386 } 387 388 if(is.null(repos) && missing(contriburl)) { 389 tmpd <- destdir 390 nonlocalrepos <- any(web <- grepl("^(http|https|ftp)://", pkgs)) 391 if(is.null(destdir) && nonlocalrepos) { 392 tmpd <- file.path(tempdir(), "downloaded_packages") 393 if (!file.exists(tmpd) && !dir.create(tmpd)) 394 stop(gettextf("unable to create temporary directory %s", 395 sQuote(tmpd)), 396 domain = NA) 397 } 398 if(nonlocalrepos) { 399 df <- function(p, destfile, method, ...) 400 download.file(p, destfile, method, mode = "wb", ...) 401 urls <- pkgs[web] 402 for (p in unique(urls)) { 403 this <- pkgs == p 404 destfile <- file.path(tmpd, basename(p)) 405 res <- try(df(p, destfile, method, ...)) 406 if(!inherits(res, "try-error") && res == 0L) 407 pkgs[this] <- destfile 408 else { 409 ## There will be enough notification from the try() 410 pkgs[this] <- NA 411 } 412 } 413 } 414 } 415 416 417 ## Look at type == "both" 418 ## NB it is only safe to use binary packages with a macOS 419 ## build that uses the same R foundation layout as CRAN since 420 ## paths in DSOs are hard-coded. 421 if (type == "both") { 422 if (type2 == "source") 423 stop("type == \"both\" can only be used on Windows or a CRAN build for macOS") 424 if (!missing(contriburl) || !is.null(available)) type <- type2 425 } 426 427 getDeps <- TRUE 428 if (type == "both") { 429 if(is.null(repos)) 430 stop("type == \"both\" cannot be used with 'repos = NULL'") 431 type <- "source" 432 contriburl <- contrib.url(repos, "source") 433 ## The line above may have changed the repos option, so ... 434 if (missing(repos)) repos <- getOption("repos") 435 available <- 436 available.packages(contriburl = contriburl, method = method, 437 fields = "NeedsCompilation", ...) 438 pkgs <- getDependencies(pkgs, dependencies, available, lib, ...) 439 getDeps <- FALSE 440 ## Now see what we can get as binary packages. 441 av2 <- available.packages(contriburl = contrib.url(repos, type2), 442 method = method, ...) 443 bins <- row.names(av2) 444 bins <- pkgs[pkgs %in% bins] 445 srcOnly <- pkgs[! pkgs %in% bins] 446 binvers <- av2[bins, "Version"] 447 448 ## In most cases, packages that need compilation have non-NA "Archs" 449 ## in their binary version and "NeedsCompilation" with value "yes" 450 ## in their source version. However, the fields are not always 451 ## filled in correctly and some binary packages have executable code 452 ## outside "libs" (so "Archs" is NA), also a later version of a 453 ## package may need compilation but an older one not. To reduce the 454 ## risk that the user will attempt to install a package from source 455 ## but without having the necessary tools to build it, packages are 456 ## treated as needing compilation whenever they have non-NA "Archs" 457 ## in binary version or/and "NeedsCompilation"="yes" in source 458 ## version. 459 460 hasArchs <- !is.na(av2[bins, "Archs"]) 461 needsCmp <- !(available[bins, "NeedsCompilation"] %in% "no") 462 hasSrc <- hasArchs | needsCmp 463 464 srcvers <- available[bins, "Version"] 465 later <- as.numeric_version(binvers) < srcvers 466 467 action <- getOption("install.packages.compile.from.source", 468 "interactive") 469 if(!nzchar(Sys.which(Sys.getenv("MAKE", "make")))) action <- "never" 470 if(any(later)) { 471 msg <- ngettext(sum(later), 472 "There is a binary version available but the source version is later", 473 "There are binary versions available but the source versions are later") 474 cat("\n", 475 paste(strwrap(msg, indent = 2, exdent = 2), collapse = "\n"), 476 ":\n", sep = "") 477 out <- data.frame(`binary` = binvers, `source` = srcvers, 478 `needs_compilation` = hasSrc, 479 row.names = bins, 480 check.names = FALSE)[later, ] 481 print(out) 482 cat("\n") 483 if(any(later & hasSrc)) { 484 if(action == "interactive" && interactive()) { 485 msg <- 486 ngettext(sum(later & hasSrc), 487 "Do you want to install from sources the package which needs compilation?", 488 "Do you want to install from sources the packages which need compilation?") 489 res <- askYesNo(msg) 490 if (is.na(res)) stop("Cancelled by user") 491 if(!isTRUE(res)) later <- later & !hasSrc 492 } else if (action == "never") { 493 cat(" Binaries will be installed\n") 494 later <- later & !hasSrc 495 } 496 } 497 } 498 bins <- bins[!later] 499 500 if(length(srcOnly)) { 501 s2 <- srcOnly[!( available[srcOnly, "NeedsCompilation"] %in% "no" )] 502 if(length(s2)) { 503 msg <- 504 ngettext(length(s2), 505 "Package which is only available in source form, and may need compilation of C/C++/Fortran", 506 "Packages which are only available in source form, and may need compilation of C/C++/Fortran") 507 msg <- c(paste0(msg, ": "), sQuote(s2)) 508 msg <- strwrap(paste(msg, collapse = " "), exdent = 2) 509 message(paste(msg, collapse = "\n"), domain = NA) 510 if(action == "interactive" && interactive()) { 511 res <- askYesNo("Do you want to attempt to install these from sources?") 512 if (is.na(res)) stop("Cancelled by user") 513 if(!isTRUE(res)) pkgs <- setdiff(pkgs, s2) 514 } else if(action == "never") { 515 cat(" These will not be installed\n") 516 pkgs <- setdiff(pkgs, s2) 517 } 518 } 519 } 520 521 if(length(bins)) { 522 if(type2 == "win.binary") 523 .install.winbinary(pkgs = bins, lib = lib, 524 contriburl = contrib.url(repos, type2), 525 method = method, available = av2, 526 destdir = destdir, 527 dependencies = NULL, 528 libs_only = libs_only, 529 quiet = quiet, ...) 530 else 531 .install.macbinary(pkgs = bins, lib = lib, 532 contriburl = contrib.url(repos, type2), 533 method = method, available = av2, 534 destdir = destdir, 535 dependencies = NULL, 536 quiet = quiet, ...) 537 } 538 pkgs <- setdiff(pkgs, bins) 539 if(!length(pkgs)) return(invisible()) 540 message(sprintf(ngettext(length(pkgs), 541 "installing the source package %s", 542 "installing the source packages %s"), 543 paste(sQuote(pkgs), collapse=", ")), 544 "\n", domain = NA) 545 flush.console() 546 ## end of "both" 547 } else if (getOption("install.packages.check.source", "yes") %in% "yes" 548 && (type %in% "win.binary" || startsWith(type, "mac.binary"))) { 549 if (missing(contriburl) && is.null(available) && !is.null(repos)) { 550 contriburl2 <- contrib.url(repos, "source") 551 # The line above may have changed the repos option, so.. 552 if (missing(repos)) repos <- getOption("repos") 553 av1 <- tryCatch(suppressWarnings( 554 available.packages(contriburl = contriburl2, method = method, ...)), 555 error = function(e)e) 556 if(inherits(av1, "error")) { 557 message("source repository is unavailable to check versions") 558 available <- 559 available.packages(contriburl = contrib.url(repos, type), 560 method = method, ...) 561 } else { 562 srcpkgs <- pkgs[pkgs %in% row.names(av1)] 563 ## Now see what we can get as binary packages. 564 available <- 565 available.packages(contriburl = contrib.url(repos, type), 566 method = method, ...) 567 bins <- pkgs[pkgs %in% row.names(available)] 568 ## so a package might only be available as source, 569 ## or it might be later in source. 570 ## FIXME: might only want to check on the same repository, 571 na <- srcpkgs[!srcpkgs %in% bins] 572 if (length(na)) { 573 msg <- 574 sprintf(ngettext(length(na), 575 "package %s is available as a source package but not as a binary", 576 "packages %s are available as source packages but not as binaries"), 577 paste(sQuote(na), collapse = ", ")) 578 cat("\n ", msg, "\n\n", sep = "") 579 } 580 binvers <- available[bins, "Version"] 581 srcvers <- binvers 582 OK <- bins %in% srcpkgs 583 srcvers[OK] <- av1[bins[OK], "Version"] 584 later <- as.numeric_version(binvers) < srcvers 585 if(any(later)) { 586 msg <- ngettext(sum(later), 587 "There is a binary version available (and will be installed) but the source version is later", 588 "There are binary versions available (and will be installed) but the source versions are later") 589 cat("\n", 590 paste(strwrap(msg, indent = 2, exdent = 2), collapse = "\n"), 591 ":\n", sep = "") 592 print(data.frame(`binary` = binvers, `source` = srcvers, 593 row.names = bins, 594 check.names = FALSE)[later, ]) 595 cat("\n") 596 } 597 } 598 } 599 } 600 601 if(.Platform$OS.type == "windows") { 602 if(startsWith(type, "mac.binary")) 603 stop("cannot install macOS binary packages on Windows") 604 605 if(type %in% "win.binary") { 606 ## include local .zip files 607 .install.winbinary(pkgs = pkgs, lib = lib, contriburl = contriburl, 608 method = method, available = available, 609 destdir = destdir, 610 dependencies = dependencies, 611 libs_only = libs_only, quiet = quiet, ...) 612 return(invisible()) 613 } 614 ## Avoid problems with spaces in pathnames. 615 have_spaces <- grep(" ", pkgs) 616 if(length(have_spaces)) { 617 ## we want the short name for the directory, 618 ## but not for a .tar.gz, and package names never contain spaces. 619 p <- pkgs[have_spaces] 620 dirs <- shortPathName(dirname(p)) 621 pkgs[have_spaces] <- file.path(dirs, basename(p)) 622 } 623 ## Avoid problems with backslashes 624 ## -- will mess up UNC names, but they don't work 625 pkgs <- gsub("\\", "/", pkgs, fixed=TRUE) 626 } else { 627 if(startsWith(type, "mac.binary")) { 628 if(!grepl("darwin", R.version$platform)) 629 stop("cannot install macOS binary packages on this platform") 630 .install.macbinary(pkgs = pkgs, lib = lib, contriburl = contriburl, 631 method = method, available = available, 632 destdir = destdir, 633 dependencies = dependencies, quiet = quiet, ...) 634 return(invisible()) 635 } 636 637 if(type %in% "win.binary") 638 stop("cannot install Windows binary packages on this platform") 639 640 if(!file.exists(file.path(R.home("bin"), "INSTALL"))) 641 stop("This version of R is not set up to install source packages\nIf it was installed from an RPM, you may need the R-devel RPM") 642 } 643 644 cmd0 <- file.path(R.home("bin"), "R") 645 args0 <- c("CMD", "INSTALL") 646 647 output <- if(quiet) FALSE else "" 648 env <- character() 649 650 tlim <- Sys.getenv("_R_INSTALL_PACKAGES_ELAPSED_TIMEOUT_") 651 tlim <- if(is.na(tlim)) 0 else tools:::get_timeout(tlim) 652 653 outdir <- getwd() 654 if(is.logical(keep_outputs)) { 655 if(is.na(keep_outputs)) 656 keep_outputs <- FALSE 657 } else if(is.character(keep_outputs) && 658 (length(keep_outputs) == 1L)) { 659 if(!dir.exists(keep_outputs) && 660 !dir.create(keep_outputs, recursive = TRUE)) 661 stop(gettextf("unable to create %s", sQuote(keep_outputs)), 662 domain = NA) 663 outdir <- normalizePath(keep_outputs) 664 keep_outputs <- TRUE 665 } else 666 stop(gettextf("invalid %s argument", sQuote("keep_outputs")), 667 domain = NA) 668 669 ## we need to ensure that R CMD INSTALL runs with the same 670 ## library trees, i.e., .R_LIBS() as this session. 671 ## FIXME: At least on Windows, either run sub-R directly (to avoid sh) 672 ## or run the install in the current process. 673 if(length(libpath <- .R_LIBS())) { 674 ## <NOTE> 675 ## For the foreseeable future, the 'env' argument to system2() 676 ## on Windows is limited to calls to make and rterm (but not R 677 ## CMD): hence need to set the R_LIBS env var here. 678 if(.Platform$OS.type == "windows") { 679 ## We don't have a way to set an environment variable for 680 ## a single command, as we do not spawn a shell. 681 oldrlibs <- Sys.getenv("R_LIBS") 682 Sys.setenv(R_LIBS = libpath) 683 on.exit(Sys.setenv(R_LIBS = oldrlibs)) 684 } else 685 env <- paste0("R_LIBS=", shQuote(libpath)) 686 ## </NOTE> 687 } 688 689 if (is.character(clean)) 690 args0 <- c(args0, clean) 691 if (libs_only) 692 args0 <- c(args0, "--libs-only") 693 if (!missing(INSTALL_opts)) { 694 if(!is.list(INSTALL_opts)) { 695 args0 <- c(args0, paste(INSTALL_opts, collapse = " ")) 696 INSTALL_opts <- list() 697 } 698 } else { 699 INSTALL_opts <- list() 700 } 701 702 if(verbose) 703 message(gettextf("system (cmd0): %s", 704 paste(c(cmd0, args0), collapse = " ")), 705 domain = NA) 706 707 if(is.null(repos) && missing(contriburl)) { 708 ## install from local source tarball(s) 709 update <- cbind(path.expand(pkgs), lib) # for side-effect of recycling to same length 710 711 for(i in seq_len(nrow(update))) { 712 if (is.na(update[i, 1L])) next 713 args <- c(args0, 714 get_install_opts(update[i, 1L]), 715 "-l", shQuote(update[i, 2L]), 716 getConfigureArgs(update[i, 1L]), 717 getConfigureVars(update[i, 1L]), 718 shQuote(update[i, 1L])) 719 status <- system2(cmd0, args, env = env, 720 stdout = output, stderr = output, 721 timeout = tlim) 722 ## if this times out it will leave locks behind 723 if(status > 0L) 724 warning(gettextf("installation of package %s had non-zero exit status", 725 sQuote(update[i, 1L])), 726 domain = NA) 727 else if(verbose) { 728 cmd <- paste(c(cmd0, args), collapse = " ") 729 message(sprintf("%d): succeeded '%s'", i, cmd), domain = NA) 730 } 731 } 732 return(invisible()) 733 } 734 735 tmpd <- destdir 736 nonlocalrepos <- !all(startsWith(contriburl, "file:")) 737 if(is.null(destdir) && nonlocalrepos) { 738 tmpd <- file.path(tempdir(), "downloaded_packages") 739 if (!file.exists(tmpd) && !dir.create(tmpd)) 740 stop(gettextf("unable to create temporary directory %s", 741 sQuote(tmpd)), 742 domain = NA) 743 } 744 745 ## from here on we deal with source packages in repos 746 av2 <- NULL 747 if(is.null(available)) { 748 filters <- getOption("available_packages_filters") 749 if(!is.null(filters)) { 750 available <- available.packages(contriburl = contriburl, 751 method = method, ...) 752 } else { 753 f <- setdiff(available_packages_filters_default, 754 c("R_version", "duplicates")) 755 av2 <- available.packages(contriburl = contriburl, filters = f, 756 method = method, ...) 757 f <- available_packages_filters_db[["R_version"]] 758 f2 <- available_packages_filters_db[["duplicates"]] 759 available <- f2(f(av2)) 760 } 761 } 762 if(getDeps) ## true except for type = "both" above. 763 pkgs <- getDependencies(pkgs, dependencies, available, lib, ..., 764 av2 = av2) 765 766 foundpkgs <- download.packages(pkgs, destdir = tmpd, available = available, 767 contriburl = contriburl, method = method, 768 type = "source", quiet = quiet, ...) 769 770 ## at this point 'pkgs' may contain duplicates, 771 ## the same pkg in different libs 772 if(length(foundpkgs)) { 773 if(verbose) message(gettextf("foundpkgs: %s", 774 paste(foundpkgs, collapse=", ")), 775 domain = NA) 776 update <- unique(cbind(pkgs, lib)) 777 colnames(update) <- c("Package", "LibPath") 778 found <- pkgs %in% foundpkgs[, 1L] 779 files <- foundpkgs[match(pkgs[found], foundpkgs[, 1L]), 2L] 780 if(verbose) message(gettextf("files: %s", 781 paste(files, collapse=", \n\t")), 782 domain = NA) 783 update <- cbind(update[found, , drop=FALSE], file = files) 784 if(nrow(update) > 1L) { 785 upkgs <- unique(pkgs <- update[, 1L]) 786 DL <- .make_dependency_list(upkgs, available) 787 p0 <- .find_install_order(upkgs, DL) 788 ## can't use update[p0, ] due to possible multiple matches 789 update <- update[sort.list(match(pkgs, p0)), ] 790 } 791 792 if (Ncpus > 1L && nrow(update) > 1L) { 793 tlim_cmd <- character() 794 if(tlim > 0) { 795 if(nzchar(timeout <- Sys.which("timeout"))) { 796 ## SIGINT works better and is used for system. 797 tlim_cmd <- c(shQuote(timeout), "--signal=INT", tlim) 798 } else 799 warning("timeouts for parallel installs require the 'timeout' command") 800 } 801 ## if --no-lock or --lock was specified in INSTALL_opts 802 ## that will override this. 803 args0 <- c(args0, "--pkglock") 804 tmpd2 <- file.path(tempdir(), "make_packages") 805 if (!file.exists(tmpd2) && !dir.create(tmpd2)) 806 stop(gettextf("unable to create temporary directory %s", 807 sQuote(tmpd2)), 808 domain = NA) 809 mfile <- file.path(tmpd2, "Makefile") 810 conn <- file(mfile, "wt") 811 deps <- paste(paste0(update[, 1L], ".ts"), collapse=" ") 812 deps <- strwrap(deps, width = 75, exdent = 2) 813 deps <- paste(deps, collapse=" \\\n") 814 cat("all: ", deps, "\n", sep = "", file = conn) 815 aDL <- .make_dependency_list(upkgs, available, recursive = TRUE) 816 for(i in seq_len(nrow(update))) { 817 pkg <- update[i, 1L] 818 fil <- update[i, 3L] 819 args <- c(args0, 820 get_install_opts(fil), 821 "-l", shQuote(update[i, 2L]), 822 getConfigureArgs(fil), 823 getConfigureVars(fil), 824 shQuote(fil), 825 ">", paste0(pkg, ".out"), 826 "2>&1") 827 ## <NOTE> 828 ## We currently only use env on Unix for R_LIBS. 829 ## Windows we do Sys.setenv(R_LIBS = libpath), 830 ## since system2() has limited support for 'env' 831 ## Should we use env on Windows as well? 832 ## If so, would we need 833 ## cmd <- paste(c(shQuote(command), env, args), 834 ## collapse = " ") 835 ## on Windows? 836 cmd <- paste(c("MAKEFLAGS=", 837 tlim_cmd, 838 shQuote(cmd0), 839 args), 840 collapse = " ") 841 ## </NOTE> 842 deps <- aDL[[pkg]] 843 deps <- deps[deps %in% upkgs] 844 ## very unlikely to be too long 845 deps <- if(length(deps)) 846 paste(paste0(deps, ".ts"), collapse = " ") else "" 847 cat(paste0(pkg, ".ts: ", deps), 848 paste("\t@echo begin installing package", sQuote(pkg)), 849 paste0("\t@", cmd, " && touch ", pkg, ".ts"), 850 paste0("\t@cat ", pkg, ".out"), 851 "", sep = "\n", file = conn) 852 } 853 close(conn) 854 cwd <- setwd(tmpd2) 855 on.exit(setwd(cwd)) 856 ## MAKE will be set by sourcing Renviron 857 status <- system2(Sys.getenv("MAKE", "make"), 858 c("-k -j", Ncpus), 859 stdout = output, stderr = output, 860 env = env) 861 if(status > 0L) { 862 ## Try to figure out which 863 pkgs <- update[, 1L] 864 tss <- sub("[.]ts$", "", dir(".", pattern = "[.]ts$")) 865 failed <- pkgs[!pkgs %in% tss] 866 for (pkg in failed) system(paste0("cat ", pkg, ".out")) 867 warning(gettextf("installation of one or more packages failed,\n probably %s", 868 paste(sQuote(failed), collapse = ", ")), 869 domain = NA) 870 } 871 if(keep_outputs) 872 file.copy(paste0(update[, 1L], ".out"), outdir) 873 ## Keep binary packages possibly created via --build 874 file.copy(Sys.glob(paste0(update[, 1L], "*.zip")), cwd) 875 file.copy(Sys.glob(paste0(update[, 1L], "*.tgz")), cwd) 876 file.copy(Sys.glob(paste0(update[, 1L], "*.tar.gz")), cwd) 877 setwd(cwd); on.exit() 878 unlink(tmpd2, recursive = TRUE) 879 } else { 880 tmpd2 <- tempfile() 881 if(!dir.create(tmpd2)) 882 stop(gettextf("unable to create temporary directory %s", 883 sQuote(tmpd2)), 884 domain = NA) 885 outfiles <- file.path(tmpd2, paste0(update[, 1L], ".out")) 886 for(i in seq_len(nrow(update))) { 887 outfile <- if(keep_outputs) outfiles[i] else output 888 fil <- update[i, 3L] 889 args <- c(args0, 890 get_install_opts(fil), 891 "-l", shQuote(update[i, 2L]), 892 getConfigureArgs(fil), 893 getConfigureVars(fil), 894 shQuote(fil)) 895 status <- system2(cmd0, args, env = env, 896 stdout = outfile, stderr = outfile, 897 timeout = tlim) 898 ## if this times out it will leave locks behind 899 if(!quiet && keep_outputs) 900 writeLines(readLines(outfile)) 901 if(status > 0L) 902 warning(gettextf("installation of package %s had non-zero exit status", 903 sQuote(update[i, 1L])), 904 domain = NA) 905 else if(verbose) { 906 cmd <- paste(c(cmd0, args), collapse = " ") 907 message(sprintf("%d): succeeded '%s'", i, cmd), 908 domain = NA) 909 } 910 } 911 if(keep_outputs) 912 file.copy(outfiles, outdir) 913 unlink(tmpd2, recursive = TRUE) 914 } 915 ## Using stderr is the wish of PR#16420 916 if(!quiet && nonlocalrepos && !is.null(tmpd) && is.null(destdir)) 917 cat("\n", gettextf("The downloaded source packages are in\n\t%s", 918 sQuote(normalizePath(tmpd, mustWork = FALSE))), 919 "\n", sep = "", file = stderr()) 920 ## update packages.html on Unix only if .Library was installed into 921 libs_used <- unique(update[, 2L]) 922 if(.Platform$OS.type == "unix" && .Library %in% libs_used) { 923 message("Updating HTML index of packages in '.Library'") 924 make.packages.html(.Library) 925 } 926 } else if(!is.null(tmpd) && is.null(destdir)) unlink(tmpd, TRUE) 927 928 invisible() 929}##end install.packages 930 931## treat variables as global in a package, for codetools & check 932globalVariables <- function(names, package, add = TRUE) 933 registerNames(names, package, ".__global__", add) 934 935## suppress foreign function checks, for check 936suppressForeignCheck <- function(names, package, add = TRUE) 937 registerNames(names, package, ".__suppressForeign__", add) 938 939registerNames <- function(names, package, .listFile, add = TRUE) { 940 .simplePackageName <- function(env) { 941 if(exists(".packageName", envir = env, inherits = FALSE)) 942 get(".packageName", envir = env) 943 else 944 "(unknown package)" 945 } 946 if(missing(package)) { 947 env <- topenv(parent.frame(2L)) # We cannot be called directly! 948 package <- .simplePackageName(env) 949 } 950 else if(is.environment(package)) { 951 env <- package 952 package <- .simplePackageName(env) 953 } 954 else 955 env <- asNamespace(package) 956 if(exists(.listFile, envir = env, inherits = FALSE)) 957 current <- get(.listFile, envir = env) 958 else 959 current <- character() 960 if(! missing(names)) { 961 if(environmentIsLocked(env)) 962 stop(gettextf("The namespace for package \"%s\" is locked; no changes in the global variables list may be made.", 963 package)) 964 if(add) 965 current <- unique(c(current, names)) 966 else 967 current <- names 968 assign(.listFile, current, envir = env) 969 } 970 current 971} 972 973packageName <- function(env = parent.frame()) { 974 if (!is.environment(env)) stop("'env' must be an environment") 975 env <- topenv(env) 976 if (!is.null(pn <- get0(".packageName", envir = env, inherits = FALSE))) 977 pn 978 else if (identical(env, .BaseNamespaceEnv)) 979 "base" 980 ## else NULL 981} 982 983##' R's .libPaths() to be used in 'R CMD ...' or similar, 984##' most easily by a previous Sys.setenv(R_LIBS = .R_LIBS()) 985## not yet exported 986.R_LIBS <- function(libp = .libPaths()) { 987 libp <- libp[! libp %in% .Library] 988 if(length(libp)) 989 paste(libp, collapse = .Platform$path.sep) 990 else "" # character(0) would fail in Sys.setenv() 991} 992