# File src/library/tools/R/build.R # Part of the R package, https://www.R-project.org # # Copyright (C) 1995-2024 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/ #### R based engine for R CMD build ## R developers can use this to debug the function by running it ## directly as tools:::.build_packages(args), where the args should ## be what commandArgs(TRUE) would return, that is a character vector ## of (space-delimited) terms that would be passed to R CMD build. writeDefaultNamespace <- function(filename, desc = file.path(dirname(filename), "DESCRIPTION")) { pkgInfo <- .split_description(.read_description(desc)) pkgs <- unique(c(names(pkgInfo$Imports), names(pkgInfo$Depends))) pkgs <- pkgs[pkgs != "base"] writeLines(c("# Default NAMESPACE created by R", "# Remove the previous line if you edit this file", "", "# Export all names", "exportPattern(\"^[^.]\")", if (length(pkgs)) c("", "# Import all packages listed as Imports or Depends", "import(", paste0(" ", pkgs, collapse = ",\n"), ")")), filename) } ### formerly Perl R::Utils::get_exclude_patterns ## Return list of file patterns excluded by R CMD build. ## Not exported. ## Has Unix-style '/' path separators hard-coded, but that is what dir() uses. get_exclude_patterns <- function() c("^\\.Rbuildignore$", "(^|/)\\.DS_Store$", "^\\.(RData|Rhistory)$", "~$", "\\.bak$", "\\.swp$", "(^|/)\\.#[^/]*$", "(^|/)#[^/]*#$", ## Outdated ... "^TITLE$", "^data/00Index$", "^inst/doc/00Index\\.dcf$", ## Autoconf "^config\\.(cache|log|status)$", "(^|/)autom4te\\.cache$", # ncdf4 had this in subdirectory 'tools' ## Windows dependency files "^src/.*\\.d$", "^src/Makedeps$", ## IRIX, of some vintage "^src/so_locations$", ## Sweave detrius "^inst/doc/Rplots\\.(ps|pdf)$" ) ## Check for files listed in .Rbuildignore or get_exclude_patterns() inRbuildignore <- function(files, pkgdir) { exclude <- rep.int(FALSE, length(files)) ignore <- get_exclude_patterns() ## handle .Rbuildignore: ## 'These patterns should be Perl regexps, one per line, ## to be matched against the file names relative to ## the top-level source directory.' ignore_file <- file.path(pkgdir, ".Rbuildignore") if (file.exists(ignore_file)) ignore <- c(ignore, readLines(ignore_file, warn = FALSE)) for(e in ignore[nzchar(ignore)]) exclude <- exclude | grepl(e, files, perl = TRUE, ignore.case = TRUE) exclude } ### based on Perl build script .build_packages <- function(args = NULL, no.q = interactive()) { ## on Windows, this requires sh make WINDOWS <- .Platform$OS.type == "windows" Sys.umask("022") # Perl version did not have this. writeLinesNL <- function(text, file) { ## a version that uses NL line endings everywhere con <- file(file, "wb") on.exit(close(con)) writeLines(text, con) } ## This version of system_with_capture merges stdout and stderr ## Used to run R to install package and build vignettes. system_with_capture <- function (command, args) { outfile <- tempfile("xshell") on.exit(unlink(outfile)) status <- system2(command, args, stdout=outfile, stderr=outfile) list(status = status, stdout = readLines(outfile, warn = FALSE)) } ## Run silently Ssystem <- function(command, args = character(), ...) system2(command, args, stdout = NULL, stderr = NULL, ...) do_exit <- if(no.q) function(status) (if(status) stop else message)( ".build_packages() exit status ", status) else function(status) q("no", status = status, runLast = FALSE) ## Used for BuildVignettes, BuildManual, BuildKeepEmpty, ## and (character not logical) BuildResaveData parse_description_field <- function(desc, field, default = TRUE, logical = TRUE) str_parse(desc[field], default=default, logical=logical) Usage <- function() { cat("Usage: R CMD build [options] pkgdirs", "", "Build R packages from package sources in the directories specified by", sQuote("pkgdirs"), "", "Options:", " -h, --help print short help message and exit", " -v, --version print version info and exit", "", " --force force removal of INDEX file", " --keep-empty-dirs do not remove empty dirs", " --no-build-vignettes do not (re)build package vignettes", " --no-manual do not build the PDF manual even if \\Sexprs are present", " --resave-data= re-save data files as compactly as possible:", ' "no", "best", "gzip" (default)', " --resave-data same as --resave-data=best", " --no-resave-data same as --resave-data=no", " --compact-vignettes= try to compact PDF files under inst/doc:", ' "no" (default), "qpdf", "gs", "gs+qpdf", "both"', " --compact-vignettes same as --compact-vignettes=qpdf", " --compression= type of compression to be used on tarball:", ' "gzip" (default), "none", "bzip2", "xz"', " --md5 add MD5 sums", " --log log to file 'pkg-00build.log' when processing ", " the pkgdir with basename 'pkg'", " --user= explicitly set the tarball creator name (for 'Packaged:')", " instead of 'Sys.info()[\"user\"]' or the \"LOGNAME\" env variable", "", "Report bugs at .", sep = "\n") } add_build_stamp_to_description_file <- function(ldpath, pkgdir, user) { db <- .read_description(ldpath) if(dir.exists(file.path(pkgdir, "src"))) db["NeedsCompilation"] <- "yes" else if(is.na(db["NeedsCompilation"])) db["NeedsCompilation"] <- "no" db["Packaged"] <- sprintf("%s; %s", format(Sys.time(), "%Y-%m-%d %H:%M:%S", tz = 'UTC', usetz = TRUE), user) ## also add_expanded_R_fields -- when not empty: fields <- .expand_package_description_db_R_fields(db) .write_description(if(length(fields)) c(db, fields) else db, ldpath) } temp_install_pkg <- function(pkgdir, libdir) { dir.create(libdir, mode = "0755", showWarnings = FALSE) if(nzchar(install_dependencies) && all((repos <- getOption("repos")) != "@CRAN@")) { ## try installing missing dependencies too available <- utils::available.packages(repos = repos) db <- .read_description(file.path(pkgdir, "DESCRIPTION")) package <- db["Package"] available <- rbind(available[available[, "Package"] != package, , drop = FALSE], db[colnames(available)]) depends <- package_dependencies(package, available, which = install_dependencies) depends <- setdiff(unlist(depends), rownames(utils::installed.packages())) if(length(depends)) { message(paste(strwrap(sprintf("installing dependencies %s", paste(sQuote(sort(depends)), collapse = ", ")), exdent = 2L), collapse = "\n"), domain = NA) utils::install.packages(depends, libdir, available = available[-nrow(available), , drop = FALSE], dependencies = NA) } } ## assume vignettes only need one arch if (WINDOWS) { cmd <- file.path(R.home("bin"), "Rcmd.exe") args <- c("INSTALL -l", shQuote(libdir), "--no-multiarch", shQuote(pkgdir)) } else { cmd <- file.path(R.home("bin"), "R") args <- c("CMD", "INSTALL -l", shQuote(libdir), "--no-multiarch", shQuote(pkgdir)) } res <- system_with_capture(cmd, args) if (res$status) { printLog(Log, " -----------------------------------\n") printLog0(Log, paste(c(res$stdout, ""), collapse = "\n")) printLog(Log, " -----------------------------------\n") unlink(libdir, recursive = TRUE) printLog(Log, "ERROR: package installation failed\n") do_exit(1L) } Sys.setenv("R_BUILD_TEMPLIB" = libdir) TRUE } ## {temp_install_pkg} prepare_pkg <- function(pkgdir, desc, Log) { owd <- setwd(pkgdir); on.exit(setwd(owd)) ## pkgname <- basename(pkgdir) checkingLog(Log, "DESCRIPTION meta-information") res <- try(.check_package_description("DESCRIPTION")) if (inherits(res, "try-error")) { resultLog(Log, "ERROR") messageLog(Log, "running '.check_package_description' failed") } else { if (any(lengths(res))) { resultLog(Log, "ERROR") print(res) # FIXME print to Log? do_exit(1L) } else resultLog(Log, "OK") } cleanup_pkg(pkgdir, Log) libdir <- tempfile("Rinst") ensure_installed <- function() if (!pkgInstalled) { messageLog(Log, "installing the package to build vignettes") pkgInstalled <<- temp_install_pkg(pkgdir, libdir) } pkgInstalled <- build_Rd_db(pkgdir, libdir, desc) if (file.exists("INDEX")) update_Rd_index("INDEX", "man", Log) doc_dir <- file.path("inst", "doc") if ("makefile" %in% dir(doc_dir)) { # avoid case-insensitive match messageLog(Log, "renaming 'inst/doc/makefile' to 'inst/doc/Makefile'") file.rename(file.path(doc_dir, "makefile"), file.path(doc_dir, "Makefile")) } if (vignettes && parse_description_field(desc, "BuildVignettes", TRUE)) { vignette_index_path <- file.path("build", "vignette.rds") if(file.exists(vignette_index_path)) unlink(vignette_index_path) ## this is not a logical field ## if (nchar(parse_description_field(desc, "VignetteBuilder", ""))) ## ensure_installed() ## PR#15775: check VignetteBuilder packages are installed ## This is a bit wasteful: we do not need them in this process loadVignetteBuilder(pkgdir, TRUE) ## Look for vignette sources vigns <- pkgVignettes(dir = '.', check = TRUE) if (!is.null(vigns) && length(vigns$docs)) { ensure_installed() ## Good to do this in a separate process: it might die creatingLog(Log, "vignettes") R_LIBS <- Sys.getenv("R_LIBS", NA_character_) if (!is.na(R_LIBS)) { on.exit(Sys.setenv(R_LIBS = R_LIBS), add = TRUE) Sys.setenv(R_LIBS = path_and_libPath(libdir, R_LIBS)) } else { # no .libPaths() here (speed; ok ?) on.exit(Sys.unsetenv("R_LIBS"), add = TRUE) Sys.setenv(R_LIBS = libdir) } ## Tangle (and weave) all vignettes now. cmd <- file.path(R.home("bin"), "Rscript") args <- c("--vanilla", "--default-packages=", # some vignettes assume methods "-e", shQuote("tools::buildVignettes(dir = '.', tangle = TRUE)")) ## since so many people use 'R CMD' in Makefiles, oPATH <- Sys.getenv("PATH") Sys.setenv(PATH = paste(R.home("bin"), oPATH, sep = .Platform$path.sep)) res <- system_with_capture(cmd, args) Sys.setenv(PATH = oPATH) if (res$status) { resultLog(Log, "ERROR") printLog0(Log, paste(c(res$stdout, ""), collapse = "\n")) do_exit(1L) } else { # Rescan for weave and tangle output files vigns <- pkgVignettes(dir = '.', output = TRUE, source = TRUE) stopifnot(!is.null(vigns)) resultLog(Log, "OK") } ## We may need to install them. if (basename(vigns$dir) == "vignettes") { ## inst may not yet exist dir.create(doc_dir, recursive = TRUE, showWarnings = FALSE) tocopy <- unique(c(vigns$docs, vigns$outputs, unlist(vigns$sources))) copied <- file.copy(tocopy, doc_dir, copy.date = TRUE) if (!all(copied)) { warning(sprintf(ngettext(sum(!copied), "%s file\n", "%s files\n"), sQuote("inst/doc")), strwrap(paste(sQuote(basename(tocopy[!copied])), collapse=", "), indent = 4, exdent = 2), "\n ignored as vignettes have been rebuilt.", "\n Run R CMD build with --no-build-vignettes to prevent rebuilding.", call. = FALSE) file.copy(tocopy[!copied], doc_dir, overwrite = TRUE, copy.date = TRUE) } unlink(c(vigns$outputs, unlist(vigns$sources))) extras_file <- file.path("vignettes", ".install_extras") if (file.exists(extras_file)) { extras <- readLines(extras_file, warn = FALSE) if(length(extras)) { allfiles <- dir("vignettes", all.files = TRUE, full.names = TRUE, recursive = TRUE, include.dirs = TRUE) inst <- rep.int(FALSE, length(allfiles)) for (e in extras) inst <- inst | grepl(e, allfiles, perl = TRUE, ignore.case = TRUE) file.copy(allfiles[inst], doc_dir, recursive = TRUE, copy.date = TRUE) } } } vignetteIndex <- .build_vignette_index(vigns) if(NROW(vignetteIndex) > 0L) { ## remove any files with no R code (they will have header comments). ## if not correctly declared they might not be in the current encoding sources <- vignetteIndex$R for(i in seq_along(sources)) { file <- file.path(doc_dir, sources[i]) if (!file_test("-f", file)) next bfr <- readLines(file, warn = FALSE) if(all(grepl("(^###|^[[:space:]]*$)", bfr, useBytes = TRUE))) { unlink(file) vignetteIndex$R[i] <- "" } } } ## Save the list dir.create("build", showWarnings = FALSE) ## version = 2L for maximal back-compatibility saveRDS(vignetteIndex, file = vignette_index_path, version = 2L) } } else { fv <- file.path("build", "vignette.rds") if(file.exists(fv)) { checkingLog(Log, "vignette meta-information") db <- readRDS(fv) pdfs <- file.path("inst", "doc", db[nzchar(db$PDF), ]$PDF) missing <- !file.exists(pdfs) if(any(missing)) { msg <- c("Output(s) listed in 'build/vignette.rds' but not in package:", strwrap(sQuote(pdfs[missing]), indent = 2L, exdent = 2L), "Run R CMD build without --no-build-vignettes to re-create") errorLog(Log, paste(msg, collapse = "\n")) do_exit(1L) } else resultLog(Log, "OK") } } if (compact_vignettes != "no" && length(pdfs <- dir(doc_dir, pattern = "[.]pdf", recursive = TRUE, full.names = TRUE))) { messageLog(Log, "compacting vignettes and other PDF files") if(compact_vignettes %in% c("gs", "gs+qpdf", "both")) { gs_cmd <- find_gs_cmd() gs_quality <- "ebook" } else { gs_cmd <- "" gs_quality <- "none" } qpdf <- if(compact_vignettes %in% c("qpdf", "gs+qpdf", "both")) Sys.which(Sys.getenv("R_QPDF", "qpdf")) else "" res <- compactPDF(pdfs, qpdf = qpdf, gs_cmd = gs_cmd, gs_quality = gs_quality) res <- format(res, diff = 1e5) if(length(res)) printLog0(Log, paste0(" ", format(res), collapse = "\n"), "\n") } if (pkgInstalled) { unlink(libdir, recursive = TRUE) ## And finally, clean up again. cleanup_pkg(pkgdir, Log) } } ## {prepare_pkg} cleanup_pkg <- function(pkgdir, Log) { owd <- setwd(pkgdir); on.exit(setwd(owd)) pkgname <- basename(pkgdir) if (dir.exists("src")) { setwd("src") messageLog(Log, "cleaning src") if (WINDOWS) { have_make <- nzchar(Sys.which(Sys.getenv("MAKE", "make"))) if (file.exists(fn <- "Makefile.ucrt") || file.exists(fn <- "Makefile.win")) { if (have_make) Ssystem(Sys.getenv("MAKE", "make"), paste0("-f ", fn, " clean")) else warning("unable to run 'make clean' in 'src'", domain = NA) } else { if (file.exists(fn <- "Makevars.ucrt") || file.exists(fn <- "Makevars.win")) { if (have_make) { makefiles <- paste("-f", shQuote(file.path(R.home("share"), "make", "clean.mk")), "-f", fn) Ssystem(Sys.getenv("MAKE", "make"), c(makefiles, "clean")) } else warning("unable to run 'make clean' in 'src'", domain = NA) } ## Also cleanup possible leftovers ... unlink(c(Sys.glob(c("*.o", "*.so", "*.dylib", "*.mod")), paste0(pkgname, c(".a", ".dll", ".def")), "symbols.rds")) if (dir.exists(".libs")) unlink(".libs", recursive = TRUE) if (dir.exists("_libs")) unlink("_libs", recursive = TRUE) } } else { makefiles <- paste("-f", shQuote(file.path(R.home("etc"), Sys.getenv("R_ARCH"), "Makeconf"))) if (file.exists("Makefile")) { makefiles <- paste(makefiles, "-f", "Makefile") Ssystem(Sys.getenv("MAKE", "make"), c(makefiles, "clean")) } else { if (file.exists("Makevars")) { ## ensure we do have a 'clean' target. makefiles <- paste(makefiles, "-f", shQuote(file.path(R.home("share"), "make", "clean.mk")), "-f Makevars") Ssystem(Sys.getenv("MAKE", "make"), c(makefiles, "clean")) } ## Also cleanup possible leftovers ... unlink(c(Sys.glob(c("*.o", "*.so", "*.dylib", "*.mod")), paste0(pkgname, c(".a", ".dll", ".def")), "symbols.rds")) if (dir.exists(".libs")) unlink(".libs", recursive = TRUE) if (dir.exists("_libs")) unlink("_libs", recursive = TRUE) } } } setwd(owd) ## It is not clear that we want to do this: INSTALL should do so. ## Also, certain environment variables should be set according ## to 'Writing R Extensions', but were not in Perl version (nor ## was cleanup.win used). if (WINDOWS) { has_cleanup_ucrt <- file.exists("cleanup.ucrt") if (has_cleanup_ucrt || file.exists("cleanup.win")) { ## check we have sh.exe first if (nzchar(Sys.which("sh.exe"))) { Sys.setenv(R_PACKAGE_NAME = pkgname) Sys.setenv(R_PACKAGE_DIR = pkgdir) Sys.setenv(R_LIBRARY_DIR = dirname(pkgdir)) if (has_cleanup_ucrt) { messageLog(Log, "running 'cleanup.ucrt'") Ssystem("sh", "./cleanup.ucrt") } else { messageLog(Log, "running 'cleanup.win'") Ssystem("sh", "./cleanup.win") } } } } else if (file_test("-x", "cleanup")) { Sys.setenv(R_PACKAGE_NAME = pkgname) Sys.setenv(R_PACKAGE_DIR = pkgdir) Sys.setenv(R_LIBRARY_DIR = dirname(pkgdir)) messageLog(Log, "running 'cleanup'") Ssystem("./cleanup") } revert_install_time_patches() } update_Rd_index <- function(oldindex, Rd_files, Log) { newindex <- tempfile() res <- tryCatch( Rdindex(Rd_files, newindex), error = function(e) { errorLog(Log, "computing Rd index failed:", conditionMessage(e)) do_exit(1L) }) checkingLog(Log, "whether ", sQuote(oldindex), " is up-to-date") if (file.exists(oldindex)) { ol <- readLines(oldindex, warn = FALSE) # e.g. BaM had missing final NL nl <- readLines(newindex) if (!identical(ol, nl)) { resultLog(Log, "NO") if (force) { messageLog(Log, "removing ", sQuote(oldindex), " as '--force' was given") unlink(oldindex) } else { messageLog(Log, "use '--force' to remove ", "the existing ", sQuote(oldindex)) unlink(newindex) } } else { resultLog(Log, "OK") unlink(newindex) } } else { resultLog(Log, "NO") messageLog(Log, "creating new ", sQuote(oldindex)) file.rename(newindex, oldindex) } } build_Rd_db <- function(pkgdir, libdir, desc) { build_partial_Rd_db_path <- file.path("build", "partial.rdb") if(file.exists(build_partial_Rd_db_path)) unlink(build_partial_Rd_db_path) ## Use a full path as this could be passed to ..Rd2pdf(). build_refman_path <- file.path(pkgdir, "build", paste0(basename(pkgdir), ".pdf")) if(file.exists(build_refman_path)) unlink(build_refman_path) db <- .build_Rd_db(pkgdir, stages = NULL, os = c("unix", "windows"), step = 1) if (!length(db)) return(FALSE) ## Strip the pkgdir off the names names(db) <- substring(names(db), nchar(file.path(pkgdir, "man")) + 2L) btinfo <- do.call(rbind, lapply(db, .Rd_get_Sexpr_build_time_info)) if(!any(btinfo[, "\\Sexpr"])) { return(FALSE) } else { ## ## Remove eventually. ## If we only have Sexprs we never process when building, ## for now create an empty partial db to make older versions ## of the CRAN incoming check code happy. if(!any(btinfo[, c("build", "later")])) { dir.create("build", showWarnings = FALSE) saveRDS(structure(list(), names = character()), build_partial_Rd_db_path, version = 2L) return(FALSE) } ## } messageLog(Log, "installing the package to process help pages") dir.create(libdir, mode = "0755", showWarnings = FALSE) savelib <- .libPaths() .libPaths(c(libdir, savelib)) on.exit(.libPaths(savelib), add = TRUE) temp_install_pkg(pkgdir, libdir) containsBuildSexprs <- which(btinfo[, "build"]) if(length(containsBuildSexprs)) { for (i in containsBuildSexprs) { db[[i]] <- prepare_Rd(db[[i]], stages = "build", stage2 = FALSE, stage3 = FALSE) ## There could be build Sexprs giving install/render ## Sexprs ... btinfo[i, ] <- .Rd_get_Sexpr_build_time_info(db[[i]]) } messageLog(Log, "saving partial Rd database") partial <- db[containsBuildSexprs] dir.create("build", showWarnings = FALSE) ## version = 2L for maximal back-compatibility saveRDS(partial, build_partial_Rd_db_path, version = 2L) } containsLaterSexprs <- which(btinfo[, "later"]) if(length(containsLaterSexprs)) { for (i in containsLaterSexprs) { db[[i]] <- prepare_Rd(db[[i]], stages = c("install", "render"), stage2 = FALSE, stage3 = FALSE) } stage23 <- db[containsLaterSexprs] dir.create("build", showWarnings = FALSE) build_stage23_Rd_db_path <- file.path("build", "stage23.rdb") if(file.exists(build_stage23_Rd_db_path)) unlink(build_stage23_Rd_db_path) saveRDS(stage23, build_stage23_Rd_db_path, version = 2L) } needRefman <- manual && parse_description_field(desc, "BuildManual", FALSE) && any(btinfo[, "later"]) if (needRefman) { messageLog(Log, "building the PDF package manual") dir.create("build", showWarnings = FALSE) ..Rd2pdf(c("--force", "--no-preview", "--quiet", paste0("--output=", build_refman_path), pkgdir), quit = FALSE) } return(TRUE) } ## {build_Rd_db} ## also fixes up missing final NL fix_nonLF_in_files <- function(pkgname, dirPattern, Log) { sDir <- file.path(pkgname, c("src", "inst/include")) files <- dir(sDir, pattern = dirPattern, full.names = TRUE, recursive = TRUE) for (ff in files) { old_time <- file.mtime(ff) lines <- readLines(ff, warn = FALSE) writeLinesNL(lines, ff) Sys.setFileTime(ff, old_time) } } fix_nonLF_in_source_files <- function(pkgname, Log) { fix_nonLF_in_files(pkgname, dirPattern = "\\.([cfh]|cc|cpp|hpp)$", Log) } fix_nonLF_in_make_files <- function(pkgname, Log) { fix_nonLF_in_files(pkgname, paste0("^(", paste(c("Makefile", "Makefile.in", "Makefile.win", "Makefile.ucrt", "Makevars", "Makevars.in", "Makevars.win", "Makevars.ucrt"), collapse = "|"), ")$"), Log) ## Other Makefiles makes <- dir(pkgname, pattern = "^Makefile$", full.names = TRUE, recursive = TRUE) for (ff in makes) { lines <- readLines(ff, warn = FALSE) writeLinesNL(lines, ff) } } fix_nonLF_in_config_files <- function(pkgname, Log) { files <- dir(pkgname, pattern = "^(configure|cleanup)$", full.names = TRUE, recursive = TRUE) ## FIXME: This "destroys" all timestamps for (ff in files) { lines <- readLines(ff, warn = FALSE) writeLinesNL(lines, ff) } } find_empty_dirs <- function(d) { ## dir(recursive = TRUE) did not include directories, so ## we needed to do this recursively files <- dir(d, all.files = TRUE, full.names = TRUE) for (dd in files[dir.exists(files)]) { if (grepl("/\\.+$", dd)) next find_empty_dirs(dd) } ## allow per-package override keep_empty1 <- parse_description_field(desc, "BuildKeepEmpty", keep_empty) if (!keep_empty1) # might have removed a dir files <- dir(d, all.files = TRUE, full.names = TRUE) if (length(files) <= 2L) { # always has ., .. if (keep_empty1) { printLog(Log, "WARNING: directory ", sQuote(d), " is empty\n") } else { unlink(d, recursive = TRUE) printLog(Log, "Removed empty directory ", sQuote(d), "\n") } } } fixup_R_dep <- function(pkgname, ver = "2.10") { desc <- .read_description(file.path(pkgname, "DESCRIPTION")) Rdeps <- .split_description(desc)$Rdepends2 for(dep in Rdeps) { if(dep$op != '>=') next if(dep$version >= package_version(ver)) return() } flatten <- function(x) { if(length(x) == 3L) paste0(x$name, " (", x$op, " ", x$version, ")") else x[[1L]] } deps <- desc["Depends"] desc["Depends"] <- if(!is.na(deps)) { deps <- .split_dependencies(deps) deps <- deps[names(deps) != "R"] # could be more than one paste(c(sprintf("R (>= %s)", ver), sapply(deps, flatten)), collapse = ", ") } else sprintf("R (>= %s)", ver) .write_description(desc, file.path(pkgname, "DESCRIPTION")) printLog(Log, " NB: this package now depends on R (>= ", ver, ")\n") } resave_data_rda <- function(pkgname, resave_data) { if (resave_data == "no") return() ddir <- file.path(pkgname, "data") if(resave_data == "best") { files <- Sys.glob(c(file.path(ddir, "*.rda"), file.path(ddir, "*.RData"), file.path(pkgname, "R", "sysdata.rda"))) messageLog(Log, "re-saving image files") resaveRdaFiles(files) rdas <- checkRdaFiles(files) if(any(rdas$compress %in% c("bzip2", "xz"))) fixup_R_dep(pkgname, "2.10") } else { ## ddir need not exist if just R/sysdata.rda rdas <- checkRdaFiles(Sys.glob(c(file.path(ddir, "*.rda"), file.path(ddir, "*.RData")))) if(nrow(rdas)) { update <- with(rdas, ASCII | compress == "none" | version < 2) if(any(update)) { messageLog(Log, "re-saving image files") resaveRdaFiles(row.names(rdas)[update], "gzip") } } if(file.exists(f <- file.path(pkgname, "R", "sysdata.rda"))) { rdas <- checkRdaFiles(f) update <- with(rdas, ASCII | compress == "none" | version < 2) if(any(update)) { messageLog(Log, "re-saving sysdata.rda") resaveRdaFiles(f, "gzip") } } } } resave_data_others <- function(pkgname, resave_data) { if (resave_data == "no") return() if(!dir.exists(ddir <- file.path(pkgname, "data"))) return() ddir <- normalizePath(ddir) dataFiles <- filtergrep("\\.(rda|RData)$", list_files_with_type(ddir, "data")) if (!length(dataFiles)) return() resaved <- character() on.exit(unlink(resaved)) Rs <- grep("\\.[Rr]$", dataFiles, value = TRUE) if (length(Rs)) { # these might use .txt etc messageLog(Log, "re-saving .R files as .rda") ## ensure utils is visible ## library("utils") lapply(Rs, function(x){ envir <- new.env(hash = TRUE) sys.source(x, chdir = TRUE, envir = envir) ## version = 2L for maximal back-compatibility save(list = ls(envir, all.names = TRUE), file = sub("\\.[Rr]$", ".rda", x), compress = TRUE, compression_level = 9, envir = envir, version = 2L) resaved <<- c(resaved, x) }) printLog(Log, " NB: *.R converted to .rda: other files may need to be removed\n") } tabs <- grep("\\.(CSV|csv|TXT|tab|txt)$", dataFiles, value = TRUE) if (length(tabs)) { messageLog(Log, "re-saving tabular files") if (resave_data == "gzip") { lapply(tabs, function(nm) { ## DiceDesign/data/greenwood.table.txt is missing NL x <- readLines(nm, warn = FALSE) con <- gzfile(paste0(nm, ".gz"), "wb") writeLines(x, con) close(con) resaved <<- c(resaved, nm) }) } else { OK <- TRUE lapply(tabs, function(nm) { x <- readLines(nm, warn = FALSE) nm3 <- paste(nm, c("gz", "bz2", "xz"), sep = ".") con <- gzfile(nm3[1L], "wb", compression = 9L); writeLines(x, con); close(con) con <- bzfile(nm3[2L], "wb", compression = 9L); writeLines(x, con); close(con) con <- xzfile(nm3[3L], "wb", compression = 9L); writeLines(x, con); close(con) sizes <- file.size(nm3) * c(0.9, 1, 1) ind <- which.min(sizes) if(ind > 1) OK <<- FALSE resaved <<- c(resaved, nm, nm3[-ind]) }) if (!OK) fixup_R_dep(pkgname, "2.10") } } } ## {resave_data_others} force <- FALSE vignettes <- TRUE manual <- TRUE # Install the manual if Rds contain \Sexprs with_md5 <- FALSE with_log <- FALSE ## INSTALL_opts <- character() pkgs <- character() options(showErrorCalls = FALSE, warn = 1) ## Read in build environment file. Renv <- Sys.getenv("R_BUILD_ENVIRON", unset = NA_character_) if(!is.na(Renv)) { ## Do not read any build environment file if R_BUILD_ENVIRON is ## set to empty of something non-existent. if(nzchar(Renv) && file.exists(Renv)) readRenviron(Renv) } else { ## Read in ~/.R/build.Renviron[.rarch] (if existent). rarch <- .Platform$r_arch if (nzchar(rarch) && file.exists(Renv <- paste0("~/.R/build.Renviron.", rarch))) readRenviron(Renv) else if (file.exists(Renv <- "~/.R/build.Renviron")) readRenviron(Renv) } ## Configurable variables. compact_vignettes <- Sys.getenv("_R_BUILD_COMPACT_VIGNETTES_", "no") resave_data <- Sys.getenv("_R_BUILD_RESAVE_DATA_", "gzip") keep_empty <- config_val_to_logical(Sys.getenv("_R_BUILD_KEEP_EMPTY_DIRS_", "FALSE")) install_dependencies <- Sys.getenv("_R_BUILD_INSTALL_DEPENDENCIES_") if(nzchar(install_dependencies) && (install_dependencies %notin% c("strong", "most", "all"))) install_dependencies <- if(config_val_to_logical(install_dependencies)) "most" else "" if (is.null(args)) { args <- commandArgs(TRUE) ## it seems that splits on spaces, so try harder. args <- paste(args, collapse = " ") args <- strsplit(args,'nextArg', fixed = TRUE)[[1L]][-1L] } user <- NULL compression <- "gzip" while(length(args)) { a <- args[1L] if (a %in% c("-h", "--help")) { Usage() do_exit(0L) } else if (a %in% c("-v", "--version")) { cat("R add-on package builder: ", R.version[["major"]], ".", R.version[["minor"]], " (r", R.version[["svn rev"]], ")\n", sep = "") cat("", .R_copyright_msg(1997), "This is free software; see the GNU General Public License version 2", "or later for copying conditions. There is NO warranty.", sep = "\n") do_exit(0L) } else if (a == "--force") { force <- TRUE } else if (a == "--keep-empty-dirs") { keep_empty <- TRUE } else if (a == "--no-build-vignettes") { vignettes <- FALSE } else if (a == "--no-vignettes") { # pre-3.0.0 version stop("'--no-vignettes' is defunct:\n use '--no-build-vignettes' instead", call. = FALSE, domain = NA) } else if (a == "--resave-data") { resave_data <- "best" } else if (a == "--no-resave-data") { resave_data <- "no" } else if (substr(a, 1, 14) == "--resave-data=") { resave_data <- substr(a, 15, 1000) } else if (a == "--no-manual") { manual <- FALSE } else if (substr(a, 1, 20) == "--compact-vignettes=") { compact_vignettes <- substr(a, 21, 1000) } else if (a == "--compact-vignettes") { compact_vignettes <- "qpdf" } else if (a == "--md5") { with_md5 <- TRUE } else if (a == "--log") { with_log <- TRUE } else if (substr(a, 1, 23) == "--install-dependencies=") { install_dependencies <- substr(a, 24, 1000) } else if (a == "--install-dependencies") { install_dependencies <- "most" } else if (substr(a, 1, 14) == "--compression=") { compression <- match.arg(substr(a, 15, 1000), c("none", "gzip", "bzip2", "xz")) } else if (substr(a, 1, 7) == "--user=") { user <- substr(a, 8, 64) } else if (startsWith(a, "-")) { message("Warning: unknown option ", sQuote(a)) } else pkgs <- c(pkgs, a) args <- args[-1L] } if(compact_vignettes %notin% c("no", "qpdf", "gs", "gs+qpdf", "both")) { warning(gettextf("invalid value for '--compact-vignettes', assuming %s", "\"qpdf\""), domain = NA) compact_vignettes <-"qpdf" } if(is.null(user)) { # not set by --user=* user <- Sys.info()[["user"]] if(user == "unknown") user <- Sys.getenv("LOGNAME") } Sys.unsetenv("R_DEFAULT_PACKAGES") startdir <- getwd() if (is.null(startdir)) stop("current working directory cannot be ascertained") ## R_platform <- Sys.getenv("R_PLATFORM", "unknown-binary") ## libdir <- tempfile("Rinst") if (WINDOWS) { ## Some people have *assumed* that R_HOME uses / in Makefiles ## Spaces in paths might still cause trouble. rhome <- chartr("\\", "/", R.home()) Sys.setenv(R_HOME = rhome) } for(pkg in pkgs) { ## remove any trailing /, for Windows' sake pkg <- sub("/$", "", pkg) ## Argh. For logging we should really know the actual name of ## the package being built, but this needs first establishing ## the actual pkgdir (see below) and then getting the package ## name from the DESCRIPTION file ... and problems in these ## steps (currently) already get logged. So for now try using ## the basename of pkg (one could try renaming at the end, but ## that will only work in case of success ...) Log <- if(with_log) newLog(paste0(file.path(startdir, basename(pkg)), "-00build.log")) else newLog() ## 'Older versions used $pkg as absolute or relative to $startdir. ## This does not easily work if $pkg is a symbolic link. ## Hence, we now convert to absolute paths.' setwd(startdir) res <- tryCatch(setwd(pkg), error = function(e) { errorLog(Log, "cannot change to directory ", sQuote(pkg)) do_exit(1L) }) pkgdir <- getwd() pkgname <- basename(pkgdir) checkingLog(Log, "for file ", sQuote(file.path(pkg, "DESCRIPTION"))) f <- file.path(pkgdir, "DESCRIPTION") if (file.exists(f)) { desc <- try(.read_description(f)) if (inherits(desc, "try-error") || !length(desc)) { resultLog(Log, "EXISTS but not correct format") do_exit(1L) } resultLog(Log, "OK") } else { resultLog(Log, "NO") do_exit(1L) } if(is.na(intname <- desc["Package"]) || !length(intname) || !nzchar(intname)) { errorLog(Log, "invalid 'Package' field"); do_exit(1L) } ## make a copy, cd to parent of copy setwd(dirname(pkgdir)) filename <- paste0(intname, "_", desc["Version"], ".tar") filepath <- file.path(startdir, filename) Tdir <- tempfile("Rbuild") dir.create(Tdir, mode = "0755") if (WINDOWS) { ## This preserves read-only for files, and dates if (!file.copy(pkgname, Tdir, recursive = TRUE, copy.date = TRUE)) { errorLog(Log, "copying to build directory failed") do_exit(1L) } } else { ## This should preserve dates and permissions (subject to ## umask, if that is consulted which it seems it usually is not). ## Permissions are increased later. ## -L is to follow (de-reference) symlinks ## --preserve is GNU only: at least macOS, FreeBSD and Solaris ## have non-GNU cp's as it seems do some Linuxen. ver <- suppressWarnings(system2("cp", "--version", stdout = TRUE, stderr = FALSE)) GNU_cp <- any(grepl("GNU coreutils", ver)) cp_sw <- if(GNU_cp) "-LR --preserve=timestamps" else "-pLR" if (system2("cp", c(cp_sw, shQuote(pkgname), shQuote(Tdir)))) { errorLog(Log, "copying to build directory failed") do_exit(1L) } } setwd(Tdir) ## Now correct the package name (PR#9266) if (pkgname != intname) { if (!file.rename(pkgname, intname)) { message(gettextf("Error: cannot rename directory to %s", sQuote(intname)), domain = NA) do_exit(1L) } pkgname <- intname } ## prepare the copy messageLog(Log, "preparing ", sQuote(pkgname), ":") prepare_pkg(normalizePath(pkgname, "/"), desc, Log); owd <- setwd(pkgname) ## remove exclude files allfiles <- dir(".", all.files = TRUE, recursive = TRUE, full.names = TRUE, include.dirs = TRUE) allfiles <- substring(allfiles, 3L) # drop './' bases <- basename(allfiles) exclude <- inRbuildignore(allfiles, pkgdir) isdir <- dir.exists(allfiles) ## old (pre-2.10.0) dirnames exclude <- exclude | (isdir & (bases %in% c("check", "chm", .vc_dir_names))) exclude <- exclude | (isdir & grepl("([Oo]ld|\\.Rcheck)$", bases)) ## FIXME: GNU make uses GNUmakefile (note capitalization) exclude <- exclude | bases %in% c("Read-and-delete-me", "GNUMakefile") ## Mac resource forks exclude <- exclude | startsWith(bases, "._") exclude <- exclude | (isdir & grepl("^src.*/[.]deps$", allfiles)) ## Windows DLL resource file exclude <- exclude | (allfiles == paste0("src/", pkgname, "_res.rc")) ## inst/doc/.Rinstignore is a mistake exclude <- exclude | endsWith(allfiles, "inst/doc/.Rinstignore") | endsWith(allfiles, "inst/doc/.build.timestamp") | endsWith(allfiles, "vignettes/.Rinstignore") ## leftovers exclude <- exclude | grepl("^.Rbuildindex[.]", allfiles) ## or simply? exclude <- exclude | startsWith(allfiles, ".Rbuildindex.") exclude <- exclude | (bases %in% .hidden_file_exclusions) ## exclude (old) source tarballs and binary packages (PR#17828) exts <- "\\.(tar\\.gz|tar|tar\\.bz2|tar\\.xz|tgz|zip)" exclude <- exclude | grepl(paste0("^", pkgname, "_[0-9.-]+", exts, "$"), allfiles) unlink(allfiles[exclude], recursive = TRUE, force = TRUE, expand = FALSE) setwd(owd) ## Fix up man, R, demo inst/doc directories res <- .check_package_subdirs(pkgname, TRUE) if (any(lengths(res))) { messageLog(Log, "excluding invalid files") print(res) # FIXME print to Log? } setwd(Tdir) ## Fix permissions for all files to be at least 644, and dirs 755 ## Not restricted by umask. if (!WINDOWS) .Call(C_dirchmod, pkgname, group.writable=FALSE) ## Add build stamp *and* expaned R fields to the DESCRIPTION file: add_build_stamp_to_description_file(file.path(pkgname, "DESCRIPTION"), pkgdir, user) messageLog(Log, "checking for LF line-endings in source and make files and shell scripts") fix_nonLF_in_source_files(pkgname, Log) fix_nonLF_in_make_files(pkgname, Log) fix_nonLF_in_config_files(pkgname, Log) messageLog(Log, "checking for empty or unneeded directories"); find_empty_dirs(pkgname) for(dir in c("Meta", "R-ex", "chtml", "help", "html", "latex")) { d <- file.path(pkgname, dir) if (dir.exists(d)) { msg <- paste("WARNING: Removing directory", sQuote(d), "which should only occur", "in an installed package") printLog(Log, paste(strwrap(msg, indent = 0L, exdent = 2L), collapse = "\n"), "\n") unlink(d, recursive = TRUE) } } ## remove subarch build directories unlink(file.path(pkgname, c("src-i386", "src-x64", "src-x86_64", "src-ppc")), recursive = TRUE) ## work on 'data' directory if present if(dir.exists(file.path(pkgname, "data")) || file_test("-f", file.path(pkgname, "R", "sysdata.rda"))) { if(!str_parse_logic(desc["LazyData"], FALSE)) { messageLog(Log, "looking to see if a 'data/datalist' file should be added") ## in some cases data() needs the package installed as ## there are links to the package's namespace tryCatch(add_datalist(pkgname), error = function(e) printLog(Log, " unable to create a 'datalist' file: may need the package to be installed\n")) } ## allow per-package override resave_data1 <- parse_description_field(desc, "BuildResaveData", resave_data, logical=FALSE) resave_data_others(pkgname, resave_data1) resave_data_rda(pkgname, resave_data1) } ## clean up DESCRIPTION file if there is (now) no data directory. if (!dir.exists(file.path(pkgname, "data"))) { desc <- file.path(pkgname, "DESCRIPTION") db <- .read_description(desc) ndb <- names(db) omit <- character() for (x in c("LazyData", "LazyDataCompression")) if (x %in% ndb) omit <- c(omit, x) if (length(omit)) { printLog(Log, sprintf("Omitted %s from DESCRIPTION\n", paste(sQuote(omit), collapse = " and "))) db <- db[!(names(db) %in% omit)] .write_description(db, desc) } } ## add dependency on R >= 3.5.0 to DESCRIPTION if there are files in ## serialization version 3 desc <- .read_description(file.path(pkgname, "DESCRIPTION")) Rdeps <- .split_description(desc)$Rdepends2 hasDep350 <- FALSE for(dep in Rdeps) { if(dep$op != '>=') next if(dep$version >= "3.5.0") hasDep350 <- TRUE } if (!hasDep350) { ## re-read files after exclusions have been applied allfiles <- dir(".", all.files = TRUE, recursive = TRUE, full.names = TRUE) allfiles <- substring(allfiles, 3L) # drop './' vers <- get_serialization_version(allfiles) toonew <- names(vers[vers >= 3L]) if (length(toonew)) { fixup_R_dep(pkgname, "3.5.0") msg <- paste("WARNING: Added dependency on R >= 3.5.0 because", "serialized objects in serialize/load version 3", "cannot be read in older versions of R. File(s)", "containing such objects:") printLog(Log, paste(c(strwrap(msg, indent = 2L, exdent = 2L), paste0(" ", .pretty_format(sort(toonew)))), collapse = "\n"), "\n") } } ## add NAMESPACE if the author didn't write one if(!file.exists(namespace <- file.path(pkgname, "NAMESPACE")) ) { messageLog(Log, "creating default NAMESPACE file") writeDefaultNamespace(namespace) } if(with_md5) { messageLog(Log, "adding MD5 file") .installMD5sums(pkgname) } else { ## remove any stale file unlink(file.path(pkgname, "MD5")) } ## Finalize ext <- switch(compression, "none"="", "gzip"= ".gz", "bzip2" = ".bz2", "xz" = ".xz") filename <- paste0(pkgname, "_", desc["Version"], ".tar", ext) filepath <- file.path(startdir, filename) ## NB: ../../../../tests/reg-packages.R relies on this exact format! messageLog(Log, "building ", sQuote(filename)) res <- utils::tar(filepath, pkgname, compression = compression, compression_level = 9L, tar = Sys.getenv("R_BUILD_TAR"), extra_flags = NULL) # use trapdoor if (res) { errorLog(Log, "packaging into tarball failed") do_exit(1L) } message("") # blank line setwd(startdir) unlink(Tdir, recursive = TRUE) closeLog(Log) } do_exit(0L) }