#  File src/library/utils/R/packages2.R
#  Part of the R package, https://www.R-project.org
#
#  Copyright (C) 1995-2025 The R Core Team
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  https://www.R-project.org/Licenses/

## FIXME: at some point we may want to allow custom binary installs on Windows as well
if (.Platform$OS.type == "windows")
    .install.macbinary <- function(...) NULL	# globalVariables isn't available, so use this to suppress the warning

isBasePkg <- function(pkg) {
  priority <- tryCatch(packageDescription(pkg, fields = "Priority", encoding = NA),
                       error = function(e) e, warning = function(e) e)
  identical(priority, "base")
}

getDependencies <-
    function(pkgs, dependencies = NA, available = NULL, lib = .libPaths()[1L],
             binary = FALSE, ..., av2 = NULL) ## ... is passed to installed.packages().
{
    if (is.null(dependencies)) return(unique(pkgs))
    oneLib <- length(lib) == 1L
    dep2 <- NULL
    if(is.logical(dependencies) && is.na(dependencies))
        dependencies <- c("Depends", "Imports", "LinkingTo")
    depends <-
        is.character(dependencies) || (is.logical(dependencies) && dependencies)
    if(depends && is.logical(dependencies)) {
        if(binary) {
            dependencies <-  c("Depends", "Imports", "Suggests")
            dep2 <- c("Depends", "Imports")
        } else {
            dependencies <-  c("Depends", "Imports", "LinkingTo", "Suggests")
            dep2 <- c("Depends", "Imports", "LinkingTo")
        }
    }
    if(depends && !oneLib) {
        warning("Do not know which element of 'lib' to install dependencies into\nskipping dependencies")
        depends <- FALSE
    }
    p0 <- unique(pkgs)
    miss <-  !p0 %in% row.names(available)
    base <- vapply(p0, isBasePkg, FALSE)
    if (sum(base))
        warning(sprintf(ngettext(sum(base),
                                 "package %s is a base package, and should not be updated",
                                 "packages %s are base packages, and should not be updated"),
                        paste(sQuote(p0[base]), collapse = ", ")),
                domain = NA, call. = FALSE)
    m0 <- miss & !base
    msg2 <- NULL
    if(sum(m0) && !is.null(av2)) {
        keep <- rownames(av2) %in% p0[m0] ## there might be duplicate matches
        av2 <- av2[keep, , drop = FALSE]
        if(nrow(av2)) {
            ds <- av2[, "Depends"]
            ds[is.na(ds)] <- ""
            x <- lapply(strsplit(sub("^[[:space:]]*", "", ds),
                                 "[[:space:]]*,[[:space:]]*"),
                        function(s) s[grepl("^R[[:space:]]*\\(", s)])
            lens <- lengths(x)
            pos <- which(lens > 0L)
            av2 <- av2[pos,, drop = FALSE]; x <- x[pos]
            msg2 <- paste(sQuote(av2[, "Package"]), "version", av2[, "Version"],
                          "is in the repositories but depends on", unlist(x))
        }
    }
    if(sum(m0)) {
        msg <- paste0(if(binary) "as a binary package ",
                      "for this version of R")
        msg3 <- c(paste0(ngettext(sum(m0),
                                  "A version of this package for your version of R might be available elsewhere,\nsee the ideas at\n",
                                  "Versions of these packages for your version of R might be available elsewhere,\nsee the ideas at\n"),
                         ## refer to r-patched for released/patched versions
                         if (grepl("Under development", R.version.string)) {
                             "https://cran.r-project.org/doc/manuals/r-devel/R-admin.html#Installing-packages"
                         } else {
                             "https://cran.r-project.org/doc/manuals/r-patched/R-admin.html#Installing-packages"
                         })
                 )
	warning(sprintf(ngettext(sum(m0),
				 "package %s is not available %s",
				 "packages %s are not available %s"),
			paste(sQuote(p0[m0]), collapse = ", "),
                        paste(c(msg, msg2, "", msg3), collapse = "\n")),
               domain = NA, call. = FALSE)
        if (sum(m0) == 1L &&
            !is.na(w <- match(tolower(p0[m0]),
                              tolower(row.names(available))))) {
            warning(sprintf("Perhaps you meant %s ?",
                            sQuote(row.names(available)[w])),
                    call. = FALSE, domain = NA)
        }
        flush.console()
    }
    p0 <- p0[!miss]

    if(depends && length(p0)) { # check for dependencies, recursively
        p1 <- p0 # this is ok, as 1 lib only
        ## INSTALL prepends 'lib' to the libpath
        ## Here we are slightly more conservative
        libpath <- .libPaths()
        if(!lib %in% libpath) libpath <- c(lib, libpath)
        installed <- installed.packages(lib.loc = libpath,
                                        fields = c("Package", "Version"),
                                        ...)
        not_avail <- character()
	repeat {
	    deps <- apply(available[p1, dependencies, drop = FALSE],
                          1L, function(x) paste(x[!is.na(x)], collapse=", "))
	    res <- .clean_up_dependencies2(deps, installed, available)
            not_avail <- c(not_avail, res[[2L]])
            deps <- unique(res[[1L]])
            ## R should not get to here, but be safe
            deps <- deps[!deps %in% c("R", pkgs)]
	    if(!length(deps)) break
	    pkgs <- c(deps, pkgs)
	    p1 <- deps
            if(!is.null(dep2)) { dependencies <- dep2; dep2 <- NULL }
	}
        if(length(not_avail)) {
            not_avail <- unique(not_avail)
            warning(sprintf(ngettext(length(not_avail),
                                     "dependency %s is not available",
                                     "dependencies %s are not available"),
                            paste(sQuote(not_avail), collapse=", ")),
                    domain = NA, call. = FALSE, immediate. = TRUE)
            flush.console()
        }

        pkgs <- unique(pkgs)
        pkgs <- pkgs[pkgs %in% row.names(available)]
        if(length(pkgs) > length(p0)) {
            added <- setdiff(pkgs, p0)
            message(sprintf(ngettext(length(added),
                                     "also installing the dependency %s",
                                     "also installing the dependencies %s"),
                            paste(sQuote(added), collapse=", ")),
                    "\n", domain = NA)
            flush.console()
        }
        p0 <- pkgs
    }
    p0
}

install.packages <-
    function(pkgs, lib, repos = getOption("repos"),
             contriburl = contrib.url(repos, type),
             method, available = NULL, destdir = NULL, dependencies = NA,
             type = getOption("pkgType"),
             configure.args = getOption("configure.args"),
             configure.vars = getOption("configure.vars"),
             clean = FALSE, Ncpus = getOption("Ncpus", 1L),
	     verbose = getOption("verbose"),
             libs_only = FALSE, INSTALL_opts, quiet = FALSE,
             keep_outputs = FALSE,
             ...)
{
    if(!(is.character(type) && length(type) == 1L))
        stop(gettextf("'%s' must be a character string", "type"), domain = NA)
    type2 <- .Platform$pkgType
    if (type == "binary") {
        if (type2 == "source")
            stop("type 'binary' is not supported on this platform")
        else type <- type2
        if(type == "both" && (!missing(contriburl) || !is.null(available)))
           stop("specifying 'contriburl' or 'available' requires a single type, not type = \"both\"")
    }
    if (is.logical(clean) && clean)
        clean <- "--clean"
    if(is.logical(dependencies) && is.na(dependencies))
        dependencies <- if(!missing(lib) && length(lib) > 1L) FALSE
        else c("Depends", "Imports", "LinkingTo")

    ## Compute the configuration arguments for a given package.
    ## If configure.args is an unnamed character vector, use that.
    ## If it is named, match the pkg name to the names of the character
    ## vector and if we get a match, use that element.
    ## Similarly, configure.args is a list(), match pkg to the names pkg
    ## and use that element, collapsing it into a single string.

    get_package_name <- function(pkg) {
        ## Since the pkg argument can be the name of a file rather than
        ## a regular package name, we have to clean that up.
        gsub("_[.](zip|tar[.](gz|bzip2|bz2|xz|zstd|zst))", "",
             gsub(.standard_regexps()$valid_package_version, "",
                  basename(pkg)))
    }

    getConfigureArgs <- function(pkg)
    {
        if(.Platform$OS.type == "windows") return(character())

        if(length(pkgs) == 1L && length(configure.args) &&
           length(names(configure.args)) == 0L)
            return(paste0("--configure-args=",
                          shQuote(paste(configure.args, collapse = " "))))

        pkg <- get_package_name(pkg)
        if (length(configure.args) && length(names(configure.args))
              && pkg %in% names(configure.args))
            config <- paste0("--configure-args=",
                             shQuote(paste(configure.args[[ pkg ]], collapse = " ")))
        else
            config <- character()

        config
    }

    getConfigureVars <- function(pkg)
    {
        if(.Platform$OS.type == "windows") return(character())

        if(length(pkgs) == 1L && length(configure.vars) &&
           length(names(configure.vars)) == 0L)
            return(paste0("--configure-vars=",
                          shQuote(paste(configure.vars, collapse = " "))))

        pkg <- get_package_name(pkg)
        if (length(configure.vars) && length(names(configure.vars))
              && pkg %in% names(configure.vars))
            config <- paste0("--configure-vars=",
                             shQuote(paste(configure.vars[[ pkg ]], collapse = " ")))
        else
            config <- character()

        config
    }

    get_install_opts <- function(pkg) {
        if(!length(INSTALL_opts))
            character()
        else
            paste(INSTALL_opts[[get_package_name(pkg)]], collapse = " ")
    }

    if(missing(pkgs)) {
        if(!interactive()) stop("no packages were specified")
        ## if no packages were specified, use a menu
	if(.Platform$OS.type == "windows" || .Platform$GUI == "AQUA"
           || (capabilities("tcltk")
               && capabilities("X11") && suppressWarnings(tcltk::.TkUp)) ) {
            ## this is the condition for a graphical select.list()
	} else
	    stop("no packages were specified")

        ## This will only offer the specified type.  If type = "both"
        ## do not want 'available' set for "source".
	if(is.null(available)) {
	    av <- available.packages(contriburl = contriburl, method = method,
                                     ...)
	    if (missing(repos)) ## Evaluating contriburl may have changed repos, which may be used below
	      repos <- getOption("repos")
            if(type != "both") available <- av
        } else av <- available
	if(NROW(av)) {
            ## avoid duplicate entries in menus, since the latest available
            ## will be picked up
            ## sort in the locale, as R <= 2.10.1 did so
	    pkgs <- select.list(sort(unique(rownames(av))),
                                multiple = TRUE,
                                title = "Packages", graphics = TRUE)
	}
    }

    if (.Platform$OS.type == "windows" && length(pkgs)) {
        ## look for package in use.
        pkgnames <- get_package_name(pkgs)
        ## there is no guarantee we have got the package name right:
        ## foo.zip might contain package bar or Foo or FOO or ....
        ## but we can't tell without trying to unpack it.
        inuse <- search()
        inuse <- sub("^package:", "", inuse[grep("^package:", inuse)])
        inuse <- pkgnames %in% inuse
        if(any(inuse)) {
            warning(sprintf(ngettext(sum(inuse),
                    "package %s is in use and will not be installed",
                    "packages %s are in use and will not be installed"),
                            paste(sQuote(pkgnames[inuse]), collapse=", ")),
                    call. = FALSE, domain = NA, immediate. = TRUE)
            pkgs <- pkgs[!inuse]
        }
    }

    if(!length(pkgs)) return(invisible())

    if(missing(lib) || is.null(lib)) {
        lib <- .libPaths()[1L]
	if(!quiet && length(.libPaths()) > 1L)
	    message(sprintf(ngettext(length(pkgs),
                                     "Installing package into %s\n(as %s is unspecified)",
                                     "Installing packages into %s\n(as %s is unspecified)"),
                            sQuote(lib), sQuote("lib")), domain = NA)
    }

    ## check for writability by user
    ok <- dir.exists(lib) & (file.access(lib, 2) == 0L)
    if(length(lib) > 1 && any(!ok))
        stop(sprintf(ngettext(sum(!ok),
                              "'lib' element %s is not a writable directory",
                              "'lib' elements %s are not writable directories"),
                     paste(sQuote(lib[!ok]), collapse=", ")), domain = NA)
    if(length(lib) == 1L && .Platform$OS.type == "windows") {
        ## file.access is unreliable on Windows, especially >= Vista.
        ## the only known reliable way is to try it
        ok <- dir.exists(lib) # dir might not exist, PR#14311
        if(ok) {
            fn <- file.path(lib, paste0("_test_dir_", Sys.getpid()))
            unlink(fn, recursive = TRUE) # precaution
            res <- try(dir.create(fn, showWarnings = FALSE))
            if(inherits(res, "try-error") || !res) ok <- FALSE
            else unlink(fn, recursive = TRUE)
        }
    }
    if(length(lib) == 1L && !ok) {
        warning(gettextf("'lib = \"%s\"' is not writable", lib),
                domain = NA, immediate. = TRUE)
        userdir <- unlist(strsplit(Sys.getenv("R_LIBS_USER"),
                                   .Platform$path.sep))[1L]
	if(interactive()) {
	    ans <- askYesNo(gettext("Would you like to use a personal library instead?"), default = FALSE)
	    if(!isTRUE(ans)) stop("unable to install packages")

	    lib <- userdir
	    if(!file.exists(userdir)) {
		ans <- askYesNo(gettextf("Would you like to create a personal library\n%s\nto install packages into?",
		                        sQuote(userdir)), default = FALSE)
		if(!isTRUE(ans)) stop("unable to install packages")
		if(!dir.create(userdir, recursive = TRUE))
                    stop(gettextf("unable to create %s", sQuote(userdir)),
                         domain = NA)
		.libPaths(c(userdir, .libPaths()))
	    }
	} else stop("unable to install packages")
    }

    lib <- normalizePath(lib)

    ## check if we should infer repos = NULL
    if(length(pkgs) == 1L && missing(repos) && missing(contriburl)) {
        if((type == "source" && any(grepl("[.]tar[.](gz|bz2|xz|zstd|zst)$", pkgs))) ||
           (type %in% "win.binary" && endsWith(pkgs, ".zip")) ||
           (startsWith(type, "mac.binary") && endsWith(pkgs, ".tgz")) ||
           (grepl("[.]binary", type) &&  any(grepl("[.]tar[.](gz|bz2|xz|zstd|zst)$", pkgs)))) {
            repos <- NULL
            message("inferring 'repos = NULL' from 'pkgs'")
        }
        if (type == "both") {
            if (type2 %in% "win.binary" && endsWith(pkgs, ".zip")) {
                repos <- NULL
                type <- type2
                message("inferring 'repos = NULL' from 'pkgs'")
            } else if (startsWith(type2, "mac.binary")
                       && endsWith(pkgs, ".tgz")) {
                repos <- NULL
                type <- type2
                message("inferring 'repos = NULL' from 'pkgs'")
            } else if (grepl("[.]tar[.](gz|bz2|xz|zstd|zst)$", pkgs)) {
                repos <- NULL
                ## can be either source or custom binary, but source falls back to
                ## R CMD INSTALL which can handle both, so choose "source" to be safe
                type <- "source"
                message("inferring 'repos = NULL' from 'pkgs'")
           }
        }
    }

    ## check if we should infer the type
    if (length(pkgs) == 1L && is.null(repos) && type == "both") {
    	if (  (type2 %in% "win.binary" && endsWith(pkgs, ".zip"))
	    ||(startsWith(type2, "mac.binary")
		   && endsWith(pkgs, ".tgz"))) {
	    type <- type2
	} else if (grepl("[.]tar[.](gz|bz2|xz|zstd|zst)$", pkgs)) {
	    type <- "source"
       }
    }

    if(is.null(repos) && missing(contriburl)) {
        tmpd <- destdir
        nonlocalrepos <- any(web <- grepl("^(http|https|ftp)://", pkgs))
        if(is.null(destdir) && nonlocalrepos) {
            tmpd <- file.path(tempdir(), "downloaded_packages")
            if (!file.exists(tmpd) && !dir.create(tmpd))
                stop(gettextf("unable to create temporary directory %s",
                              sQuote(tmpd)),
                     domain = NA)
        }
        if(nonlocalrepos) {
            df <- function(p, destfile, method, ...)
                download.file(p, destfile, method, mode = "wb", ...)
            urls <- unique(pkgs[web])

            if (.download.file.method(method) %in% c("auto", "libcurl")) {
                # bulk download using libcurl
                destfiles <- file.path(tmpd, basename(urls))
                res <- try(df(urls, destfiles, "libcurl", ...))
                if(!inherits(res, "try-error") && res == 0L) {
                    if (length(urls) > 1) {
                        retvals <- attr(res, "retvals")
                        for(i in seq_along(retvals)) {
                            this <- pkgs == urls[i]
                            if (retvals[i] == 0L)
                                pkgs[this] <- destfiles[i]
                            else
                                pkgs[this] <- NA
                        }
                    } else
                        pkgs[web] <- destfiles
                } else
                    pkgs[web] <- NA
            } else {
                # serial download
                for (p in urls) {
                    this <- pkgs == p
                    destfile <- file.path(tmpd, basename(p))
                    res <- try(df(p, destfile, method, ...))
                    if(!inherits(res, "try-error") && res == 0L)
                        pkgs[this] <- destfile
                    else {
                        ## There will be enough notification from the try()
                        pkgs[this] <- NA
                    }
                }
            }
        }
    }

    ## Look at type == "both"
    ## NB it is only safe to use binary packages with a macOS
    ## build that uses the same R foundation layout as CRAN since
    ## paths in DSOs are hard-coded.
    if (type == "both") {
        if (type2 == "source")
            stop("type == \"both\" can only be used in R builds that have well-defined binary type (e.g., CRAN binary releases)")
        if (!missing(contriburl) || !is.null(available)) type <- type2
    }

    getDeps <- TRUE
    if (type == "both") {
        if(is.null(repos))
            stop("type == \"both\" cannot be used with 'repos = NULL'")
        type <- "source"
        contriburl <- contrib.url(repos, "source")
        ## The line above may have changed the repos option, so ...
        if (missing(repos)) repos <- getOption("repos")
        available <-
            available.packages(contriburl = contriburl, method = method,
                               fields = "NeedsCompilation", ...)
        pkgs <- getDependencies(pkgs, dependencies, available, lib, ...)
        getDeps <- FALSE
        ## Now see what we can get as binary packages.
        av2 <- available.packages(contriburl = contrib.url(repos, type2),
                                  method = method, ...)
        bins <- row.names(av2)
        bins <- pkgs[pkgs %in% bins]
        srcOnly <- pkgs[! pkgs %in% bins]
        binvers <- av2[bins, "Version"]

        ## In most cases, packages that need compilation have non-NA "Archs"
        ## in their binary version and "NeedsCompilation" with value "yes"
        ## in their source version.  However, the fields are not always
        ## filled in correctly and some binary packages have executable code
        ## outside "libs" (so "Archs" is NA), also a later version of a
        ## package may need compilation but an older one not.  To reduce the
        ## risk that the user will attempt to install a package from source
        ## but without having the necessary tools to build it, packages are
        ## treated as needing compilation whenever they have non-NA "Archs"
        ## in binary version or/and "NeedsCompilation"="yes" in source
        ## version.

        hasArchs <-  !is.na(av2[bins, "Archs"])
        needsCmp <- !(available[bins, "NeedsCompilation"] %in% "no")
        hasSrc <- hasArchs | needsCmp

        srcvers <- available[bins, "Version"]
        later <- as.numeric_version(binvers) < srcvers

        action <- getOption("install.packages.compile.from.source",
                            "interactive")
        if(!nzchar(Sys.which(Sys.getenv("MAKE", "make")))) action <- "never"

        ## Combining sources and binaries is currently broken (#18396), so
        ## at least on macOS we want to avoid it as much as we can. If
        ## binaries exist for all desired packages (regardless of version),
        ## sources will be ignored.
        if (grepl("darwin", R.version$platform) && !length(srcOnly))
            later[later] <- FALSE

        if(any(later)) {
            msg <- ngettext(sum(later),
                            "There is a binary version available but the source version is later",
                            "There are binary versions available but the source versions are later")
            cat("\n",
                paste(strwrap(msg, indent = 2, exdent = 2), collapse = "\n"),
                ":\n", sep = "")
            out <- data.frame(`binary` = binvers, `source` = srcvers,
                              `needs_compilation` =  hasSrc,
                              row.names = bins,
                              check.names = FALSE)[later, ]
            print(out)
            cat("\n")
            if(any(later & hasSrc)) {
                if(action == "interactive" && interactive()) {
                    msg <-
                        ngettext(sum(later & hasSrc),
                                 "Do you want to install from sources the package which needs compilation?",
                                 "Do you want to install from sources the packages which need compilation?")
                    res <- askYesNo(msg)
                    if (is.na(res)) stop("Cancelled by user")
                    if(!isTRUE(res)) later <- later & !hasSrc
                } else if (action == "never") {
                    cat("  Binaries will be installed\n")
                    later <- later & !hasSrc
                }
            }
        }
        bins <- bins[!later]

        ## This is unsafe (see above), but if there is no binary, there is really no choice.
        ## If this fails, the user can still use type='source' to recover.
        if(length(srcOnly)) {
            s2 <- srcOnly[!( available[srcOnly, "NeedsCompilation"] %in% "no" )]
            if(length(s2)) {
                msg <-
                    ngettext(length(s2),
                             "Package which is only available in source form, and may need compilation of C/C++/Fortran",
                             "Packages which are only available in source form, and may need compilation of C/C++/Fortran")
                msg <- c(paste0(msg, ": "), sQuote(s2))
                msg <- strwrap(paste(msg, collapse = " "), exdent = 2)
                message(paste(msg, collapse = "\n"), domain = NA)
                if(action == "interactive" && interactive()) {
                    res <- askYesNo("Do you want to attempt to install these from sources?")
                    if (is.na(res)) stop("Cancelled by user")
                    if(!isTRUE(res)) pkgs <- setdiff(pkgs, s2)
                } else if(action == "never") {
                    cat("  These will not be installed\n")
                    pkgs <- setdiff(pkgs, s2)
                }
            }
        }

        if(length(bins)) {
            if(startsWith(type2, "win.binary"))
                .install.winbinary(pkgs = bins, lib = lib,
                                   contriburl = contrib.url(repos, type2),
                                   method = method, available = av2,
                                   destdir = destdir,
                                   dependencies = NULL,
                                   libs_only = libs_only,
                                   quiet = quiet, ...)
            else
                .install.macbinary(pkgs = bins, lib = lib,
                                   contriburl = contrib.url(repos, type2),
                                   method = method, available = av2,
                                   destdir = destdir,
                                   dependencies = NULL,
                                   quiet = quiet, ...)
        }
        pkgs <- setdiff(pkgs, bins)
        if(!length(pkgs)) return(invisible())
        message(sprintf(ngettext(length(pkgs),
                                     "installing the source package %s",
                                     "installing the source packages %s"),
                        paste(sQuote(pkgs), collapse=", ")),
                "\n", domain = NA)
	flush.console()
        ## end of "both"
    } else if (getOption("install.packages.check.source", "yes") %in% "yes"
               && (grepl("^[[:lower::]]+[.]binary", type))) {
        if (missing(contriburl) && is.null(available) && !is.null(repos)) {
            contriburl2 <- contrib.url(repos, "source")
	    # The line above may have changed the repos option, so..
            if (missing(repos)) repos <- getOption("repos")
	    av1 <- tryCatch(suppressWarnings(
			available.packages(contriburl = contriburl2, method = method, ...)),
			    error = function(e)e)
	    if(inherits(av1, "error")) {
                message("source repository is unavailable to check versions")
                available <-
                    available.packages(contriburl = contrib.url(repos, type),
                                       method = method, ...)
            } else {
                srcpkgs <- pkgs[pkgs %in% row.names(av1)]
                ## Now see what we can get as binary packages.
                available <-
                    available.packages(contriburl = contrib.url(repos, type),
                                       method = method, ...)
                bins <- pkgs[pkgs %in% row.names(available)]
                ## so a package might only be available as source,
                ## or it might be later in source.
                ## FIXME: might only want to check on the same repository,
                na <- srcpkgs[!srcpkgs %in% bins]
                if (length(na)) {
                    msg <-
                        sprintf(ngettext(length(na),
                                         "package %s is available as a source package but not as a binary",
                                         "packages %s are available as source packages but not as binaries"),
                                paste(sQuote(na), collapse = ", "))
                    cat("\n   ", msg, "\n\n", sep = "")
                }
                binvers <- available[bins, "Version"]
                srcvers <- binvers
                OK <- bins %in% srcpkgs
                srcvers[OK] <- av1[bins[OK], "Version"]
                later <- as.numeric_version(binvers) < srcvers
                if(any(later)) {
                    msg <- ngettext(sum(later),
                                    "There is a binary version available (and will be installed) but the source version is later",
                                    "There are binary versions available (and will be installed) but the source versions are later")
                    cat("\n",
                        paste(strwrap(msg, indent = 2, exdent = 2), collapse = "\n"),
                        ":\n", sep = "")
                    print(data.frame(`binary` = binvers, `source` = srcvers,
                                     row.names = bins,
                                     check.names = FALSE)[later, ])
                    cat("\n")
                }
            }
        }
    }

    if(.Platform$OS.type == "windows") {
        ## FIXME: we may want allow custom binaries on Windows as well...
        if(!startsWith(type, "win.binary") && type != "source")
            stop("cannot install binary packages from other operating systems on Windows")

        if(startsWith(type, "win.binary")) {
            ## include local .zip files
            .install.winbinary(pkgs = pkgs, lib = lib, contriburl = contriburl,
                               method = method, available = available,
                               destdir = destdir,
                               dependencies = dependencies,
                               libs_only = libs_only, quiet = quiet,  ...)
            return(invisible())
        }
        ## Avoid problems with spaces in pathnames.
        have_spaces <- grep(" ", pkgs)
        if(length(have_spaces)) {
            ## we want the short name for the directory,
            ## but not for a .tar.gz, and package names never contain spaces.
            p <- pkgs[have_spaces]
            dirs <- shortPathName(dirname(p))
            pkgs[have_spaces] <- file.path(dirs, basename(p))
        }
        ## Avoid problems with backslashes
        ## -- will mess up UNC names, but they don't work
        pkgs <- gsub("\\", "/", pkgs, fixed=TRUE)
    } else {
        if(startsWith(type, "win.binary"))
            stop("cannot install Windows binary packages on this platform")

        if(grepl("^[[:lower:]]+[.]binary", type)) {
            .install.macbinary(pkgs = pkgs, lib = lib, contriburl = contriburl,
                               method = method, available = available,
                               destdir = destdir,
                               dependencies = dependencies, quiet = quiet, ...)
            return(invisible())
        }

        if(!file.exists(file.path(R.home("bin"), "INSTALL")))
            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")
    }

    cmd0 <- file.path(R.home("bin"), "R")
    args0 <- c("CMD", "INSTALL")

    output <- if(quiet) FALSE else ""
    env <- character()

    tlim <- Sys.getenv("_R_INSTALL_PACKAGES_ELAPSED_TIMEOUT_")
    tlim <- if(!nzchar(tlim)) 0 else tools:::get_timeout(tlim)

    outdir <- getwd()
    if(is.logical(keep_outputs)) {
        if(is.na(keep_outputs))
            keep_outputs <- FALSE
    } else if(is.character(keep_outputs) &&
              (length(keep_outputs) == 1L)) {
        if(!dir.exists(keep_outputs) &&
           !dir.create(keep_outputs, recursive = TRUE))
            stop(gettextf("unable to create %s", sQuote(keep_outputs)),
                 domain = NA)
        outdir <- normalizePath(keep_outputs)
        keep_outputs <- TRUE
    } else
        stop(gettextf("invalid %s argument", sQuote("keep_outputs")),
             domain = NA)

    ## we need to ensure that R CMD INSTALL runs with the same
    ## library trees, i.e., .R_LIBS() as this session.
    ## FIXME: At least on Windows, either run sub-R directly (to avoid sh)
    ## or run the install in the current process.
    if(length(libpath <- .R_LIBS())) {
        ## <NOTE>
        ## For the foreseeable future, the 'env' argument to system2()
        ## on Windows is limited to calls to make and rterm (but not R
        ## CMD): hence need to set the R_LIBS env var here.
        if(.Platform$OS.type == "windows") {
            ## We don't have a way to set an environment variable for
            ## a single command, as we do not spawn a shell.
            oldrlibs <- Sys.getenv("R_LIBS")
            Sys.setenv(R_LIBS = libpath)
            on.exit(Sys.setenv(R_LIBS = oldrlibs))
        } else
            env <- paste0("R_LIBS=", shQuote(libpath))
        ## </NOTE>
    }

    if (is.character(clean))
        args0 <- c(args0, clean)
    if (libs_only)
        args0 <- c(args0, "--libs-only")
    if (!missing(INSTALL_opts)) {
        if(!is.list(INSTALL_opts)) {
            args0 <- c(args0, paste(INSTALL_opts, collapse = " "))
            INSTALL_opts <- list()
        }
    } else {
        INSTALL_opts <- list()
    }

    if(verbose)
        message(gettextf("system (cmd0): %s",
                         paste(c(cmd0, args0), collapse = " ")),
                domain = NA)

    if(is.null(repos) && missing(contriburl)) {
        ## install from local source tarball(s)
        update <- cbind(path.expand(pkgs), lib) # for side-effect of recycling to same length

       for(i in seq_len(nrow(update))) {
           if (is.na(update[i, 1L])) next
           args <- c(args0,
                     get_install_opts(update[i, 1L]),
                     "-l",    shQuote(update[i, 2L]),
                     getConfigureArgs(update[i, 1L]),
                     getConfigureVars(update[i, 1L]),
                     shQuote(update[i, 1L]))
           status <- system2(cmd0, args, env = env,
                             stdout = output, stderr = output,
                             timeout = tlim)
           ## if this times out it will leave locks behind
           if(status > 0L)
               warning(gettextf("installation of package %s had non-zero exit status",
                                sQuote(update[i, 1L])),
                       domain = NA)
           else if(verbose) {
               cmd <- paste(c(cmd0, args), collapse = " ")
               message(sprintf("%d): succeeded '%s'", i, cmd), domain = NA)
           }
       }
        return(invisible())
    }

    tmpd <- destdir
    nonlocalrepos <- !all(startsWith(contriburl, "file:"))
    if(is.null(destdir) && nonlocalrepos) {
        tmpd <- file.path(tempdir(), "downloaded_packages")
        if (!file.exists(tmpd) && !dir.create(tmpd))
            stop(gettextf("unable to create temporary directory %s",
                          sQuote(tmpd)),
                 domain = NA)
    }

    ## from here on we deal with source packages in repos
    av2 <- NULL
    if(is.null(available)) {
        filters <- getOption("available_packages_filters")
        if(!is.null(filters) ||
           any(!is.na(pmatch(...names(), "filters")))) {
            available <- available.packages(contriburl = contriburl,
                                            method = method, ...)
        } else {
            f <- setdiff(available_packages_filters_default,
                         c("R_version", "duplicates"))
            av2 <- available.packages(contriburl = contriburl, filters = f,
                                      method = method, ...)
            f <- available_packages_filters_db[["R_version"]]
            f2 <- available_packages_filters_db[["duplicates"]]
            available <- f2(f(av2))
        }
    }
    if(getDeps) ## true except for type = "both" above.
        pkgs <- getDependencies(pkgs, dependencies, available, lib, ...,
                                av2 = av2)

    foundpkgs <- download.packages(pkgs, destdir = tmpd, available = available,
                                   contriburl = contriburl, method = method,
                                   type = "source", quiet = quiet, ...)

    ## at this point 'pkgs' may contain duplicates,
    ## the same pkg in different libs
    if(length(foundpkgs)) {
	if(verbose) message(gettextf("foundpkgs: %s",
                                     paste(foundpkgs, collapse=", ")),
                            domain = NA)
        update <- unique(cbind(pkgs, lib))
        colnames(update) <- c("Package", "LibPath")
        found <- pkgs %in% foundpkgs[, 1L]
        files <- foundpkgs[match(pkgs[found], foundpkgs[, 1L]), 2L]
	if(verbose) message(gettextf("files: %s",
                                     paste(files, collapse=", \n\t")),
                            domain = NA)
        update <- cbind(update[found, , drop=FALSE], file = files)
        if(nrow(update) > 1L) {
            upkgs <- unique(pkgs <- update[, 1L])
            DL <- .make_dependency_list(upkgs, available)
            p0 <- .find_install_order(upkgs, DL)
            ## can't use update[p0, ] due to possible multiple matches
            update <- update[sort.list(match(pkgs, p0)), ]
        }

        if (Ncpus > 1L && nrow(update) > 1L) {
            tlim_cmd <- character()
            if(tlim > 0) {
                if(.Platform$OS.type == "windows" &&
                   !nzchar(Sys.getenv("R_TIMEOUT")) &&
                   grepl("\\windows\\system32\\", tolower(Sys.which("timeout")),
                         fixed=TRUE)) {

                    warning("Windows default 'timeout' command is not usable for parallel installs")

                } else if(nzchar(timeout <- Sys.which(Sys.getenv("R_TIMEOUT", "timeout")))) {
                    ## SIGINT works better and is used for system.
                    tlim_cmd <- c(shQuote(timeout), "-s INT", tlim)
                } else
                    warning("timeouts for parallel installs require the 'timeout' command")
            }
            ## if --no-lock or --lock was specified in INSTALL_opts
            ## that will override this.
            args0 <- c(args0, "--pkglock")
            tmpd2 <- file.path(tempdir(), "make_packages")
            if (!file.exists(tmpd2) && !dir.create(tmpd2))
                stop(gettextf("unable to create temporary directory %s",
                              sQuote(tmpd2)),
                     domain = NA)
            mfile <- file.path(tmpd2, "Makefile")
            conn <- file(mfile, "wt")
            deps <- paste(paste0(update[, 1L], ".ts"), collapse=" ")
            deps <- strwrap(deps, width = 75, exdent = 2)
            deps <- paste(deps, collapse=" \\\n")
            cat("all: ", deps, "\n", sep = "", file = conn)
            aDL <- .make_dependency_list(upkgs, available, recursive = TRUE)
            for(i in seq_len(nrow(update))) {
                pkg <- update[i, 1L]
                fil <- update[i, 3L]
                args <- c(args0,
                          get_install_opts(fil),
                          "-l", shQuote(update[i, 2L]),
                          getConfigureArgs(fil),
                          getConfigureVars(fil),
                          shQuote(fil),
                          ">", paste0(pkg, ".out"),
                          "2>&1")
                ## <NOTE>
                ## We currently only use env on Unix for R_LIBS.
                ## Windows we do Sys.setenv(R_LIBS = libpath),
                ## since system2() has limited support for 'env'
                ## Should we use env on Windows as well?
                ## If so, would we need
                ##   cmd <- paste(c(shQuote(command), env, args),
                ##                collapse = " ")
                ## on Windows?
                cmd <- paste(c("MAKEFLAGS=",
                               tlim_cmd,
                               shQuote(cmd0),
                               args),
                             collapse = " ")
                ## </NOTE>
                deps <- aDL[[pkg]]
                deps <- deps[deps %in% upkgs]
                ## very unlikely to be too long
                deps <- if(length(deps))
                    paste(paste0(deps, ".ts"), collapse = " ") else ""
                cat(paste0(pkg, ".ts: ", deps),
                    paste("\t@echo begin installing package", sQuote(pkg)),
                    paste0("\t@", cmd, " && touch ", pkg, ".ts"),
                    paste0("\t@cat ", pkg, ".out"),
                    "", sep = "\n", file = conn)
            }
            close(conn)
            cwd <- setwd(tmpd2)
            on.exit(setwd(cwd))
            ## MAKE will be set by sourcing Renviron
            status <- system2(Sys.getenv("MAKE", "make"),
                              c("-k -j", Ncpus),
                              stdout = output, stderr = output,
                              env = env)
            if(status > 0L) {
                ## Try to figure out which
                pkgs <- update[, 1L]
                tss <- sub("[.]ts$", "", dir(".", pattern = "[.]ts$"))
                failed <- pkgs[!pkgs %in% tss]
                for (pkg in failed) {
                    ## targets with failed dependencies are not made (even with -k)
                    if (file.exists(outfile <- paste0(pkg, ".out")))
                        system2("cat", outfile)
                    ##else cat("skipped installing package ", pkg, "\n", sep = "")
                }
                n <- length(failed)
                if (n == 1L)
                    warning(gettextf("installation of package %s failed",
                                     sQuote(failed)), domain = NA)
                else if (n > 1L) {
                    msg <- paste(sQuote(failed), collapse = ", ")
                    if(nchar(msg) < 40)
                        warning(gettextf( "installation of %d packages failed:  %s",
                                         n, msg),
                                domain = NA)
                    else
                        warning(gettextf( "installation of %d packages failed:\n  %s",
                                         n, msg),
                                domain = NA)
                     }
            }
            if(keep_outputs) {
                outfiles <- paste0(update[, 1L], ".out") # some could be missing
                file.copy(outfiles[file.exists(outfiles)],
                          outdir, overwrite = TRUE)
            }
            ## Keep binary packages possibly created via --build
            file.copy(Sys.glob(paste0(update[, 1L], "*.zip")), cwd)
            file.copy(Sys.glob(paste0(update[, 1L], "*.tgz")), cwd)
            file.copy(Sys.glob(paste0(update[, 1L], "*.tar.gz")), cwd)
            setwd(cwd); on.exit()
            unlink(tmpd2, recursive = TRUE)
        } else {
            tmpd2 <- tempfile()
            if(!dir.create(tmpd2))
                stop(gettextf("unable to create temporary directory %s",
                              sQuote(tmpd2)),
                     domain = NA)
            outfiles <- file.path(tmpd2, paste0(update[, 1L], ".out"))
            for(i in seq_len(nrow(update))) {
                outfile <- if(keep_outputs) outfiles[i] else output
                fil <- update[i, 3L]
                args <- c(args0,
                          get_install_opts(fil),
                          "-l", shQuote(update[i, 2L]),
                          getConfigureArgs(fil),
                          getConfigureVars(fil),
                          shQuote(fil))
                status <- system2(cmd0, args, env = env,
                                  stdout = outfile, stderr = outfile,
                                  timeout = tlim)
                ## if this times out it will leave locks behind
                if(!quiet && keep_outputs)
                    writeLines(readLines(outfile))
                if(status > 0L)
                    warning(gettextf("installation of package %s had non-zero exit status",
                                     sQuote(update[i, 1L])),
                            domain = NA)
		else if(verbose) {
                    cmd <- paste(c(cmd0, args), collapse = " ")
                    message(sprintf("%d): succeeded '%s'", i, cmd),
                            domain = NA)
                }
            }
            if(keep_outputs)
                file.copy(outfiles, outdir, overwrite = TRUE)
            unlink(tmpd2, recursive = TRUE)
        }
        ## Using stderr is the wish of PR#16420
        if(!quiet && nonlocalrepos && !is.null(tmpd) && is.null(destdir))
            cat("\n", gettextf("The downloaded source packages are in\n\t%s",
                               sQuote(normalizePath(tmpd, mustWork = FALSE))),
                "\n", sep = "", file = stderr())
        ## update packages.html on Unix only if .Library was installed into
        libs_used <- unique(update[, 2L])
        if(.Platform$OS.type == "unix" && .Library %in% libs_used) {
            message("Updating HTML index of packages in '.Library'")
            make.packages.html(.Library)
        }
    } else if(!is.null(tmpd) && is.null(destdir)) unlink(tmpd, TRUE)

    invisible()
}##end install.packages

## treat variables as global in a package, for codetools & check
globalVariables <- function(names, package, add = TRUE)
    registerNames(names, package, ".__global__", add)

## suppress foreign function checks, for check
suppressForeignCheck <- function(names, package, add = TRUE)
    registerNames(names, package, ".__suppressForeign__", add)

registerNames <- function(names, package, .listFile, add = TRUE) {
    .simplePackageName <- function(env) {
        get0(".packageName", envir = env, inherits = FALSE,
             ifnotfound = "(unknown package)")
    }
    if(missing(package)) {
        env <- topenv(parent.frame(2L)) # We cannot be called directly!
        package <- .simplePackageName(env)
    }
    else if(is.environment(package)) {
        env <- package
        package <- .simplePackageName(env)
    }
    else
        env <- asNamespace(package)

    current <- get0(.listFile, envir = env, inherits = FALSE, ifnotfound = character())
    if(! missing(names)) {
        if(environmentIsLocked(env))
            stop(gettextf("The namespace for package \"%s\" is locked; no changes in the global variables list may be made.",
                          package))
        current <- if(add) unique(c(current, names)) else names
        assign(.listFile, current, envir = env)
    }
    current
}

packageName <- function(env = parent.frame()) {
    if (!is.environment(env)) stop("'env' must be an environment")
    env <- topenv(env)
    get0(".packageName", envir = env, inherits = FALSE) %||%
        if(identical(env, .BaseNamespaceEnv)) "base" ## else NULL
}

##' R's .libPaths() to be used in 'R CMD ...' or similar,
##' most easily by a previous  Sys.setenv(R_LIBS = .R_LIBS())
## not yet exported
.R_LIBS <- function(libp = .libPaths()) {
    libp <- libp[! libp %in% .Library]
    if(length(libp))
        paste(libp, collapse = .Platform$path.sep)
    else "" # character(0) would fail in Sys.setenv()
}
