#' Build R binary packages #' @import progressr #' @importFrom future plan #' @importFrom future.apply future_mapply #' @importFrom progressr with_progress progressor #' @importFrom gert git_config_global_set git_clone #' @importFrom pak local_install_dev_deps #' @importFrom pkgbuild build #' @export build_binary_package <- function(package_name, tag = NULL, codename = NULL, r_minor_version = NULL, build_for_minor = TRUE, local_build_root = "/root", local_clone_dir = "/tmp", platform = "redhat-9", install_system_dependencies = TRUE, debug = FALSE, force = FALSE) { cli::cli_h2("Preparations ({.pkg {package_name}})") codename <- set_codename(codename) if (debug) { cli::cli_alert_warning("DEBUG: codename {codename}.") } if (is.null(r_minor_version)) { r_minor_version <- sub("R version (\\d+\\.\\d+).*", "\\1", R.Version()$version.string) } # create directory structure dir_out_bin <- set_bin_path(r_minor_version, build_for_minor, local_build_root, codename) if (debug) { cli::cli_alert_warning("DEBUG: dir_out_bin {dir_out_bin}.") } dir_out_src <- sprintf("%s/src/contrib/Archive", local_build_root) if (debug) { cli::cli_alert("{.fun build_binary_package}: Creating bin dir {.path {dir_out_bin}}.") cli::cli_alert("{.fun build_binary_package}: Creating src dir {.path {dir_out_src}}.") } dir.create(sprintf("%s/Archive", dir_out_bin), sprintf("%s/Archive", dir_out_src), recursive = TRUE ) cli::cli_h2("Installing system dependencies ({.pkg {package_name}})") gert::git_config_global_set("advice.detachedHead", "false") if (is.null(tag)) { gert::git_clone(sprintf("https://github.com/cran/%s", package_name), path = sprintf("%s/%s", tempdir(), "tmp1"), verbose = FALSE ) # Retrieve all tags all_tags <- gert::git_tag_list(repo = sprintf("%s/%s", tempdir(), "tmp1")) # filter out tags that start with R- (= non-valid ones) all_tags <- all_tags[!grepl("R-", all_tags$name), ] unlink(sprintf("%s/%s", tempdir(), "tmp1"), force = TRUE, recursive = TRUE) tag <- all_tags$name package_name <- rep(package_name, length(tag)) } ### Install system dependencies if (install_system_dependencies) { install_package_system_dependencies(package_name, tag, platform, local_clone_dir) } t1 <- Sys.time() cli::cli_h2("Building ({.pkg {package_name[1]}})") cli::cli_alert("Building binaries for {.pkg {package_name[[1]]}} with tags {.field {tag}}.") # Set up the progress handler progressr::handlers(global = TRUE) progressr::handlers("cli", "debug") out <- progressr::with_progress({ p <- progressr::progressor(along = tag) future.apply::future_mapply(function(x, y) { tryCatch( { p() dump <- build_single_tag(x, y, dir_out_bin, local_clone_dir, platform = platform, debug = debug) store_build_metadata(x, y, platform, error_occurred = FALSE, force = force) con <- DBI::dbConnect(RPostgres::Postgres(), dbname = "build_metadata", host = "postgres-arm-binaries-r.devxy.io", port = 15432, user = "arm_binaries", password = Sys.getenv("PGPASS") ) dbDisconnect(con) }, error = function(e) { message(sprintf("Error in processing package %s with tag %s: %s", x, y, e)) local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, x, y) unlink(local_clone_dir_single, force = TRUE, recursive = TRUE) # only stderr contains the important information why the build failed store_build_metadata(x, y, platform, error_occurred = TRUE, force = TRUE, error = e$stderr) } ) }, package_name, tag, future.seed = TRUE) }) total_build_time <- round(Sys.time() - t1, 2) cli::cli_alert("Execution time ({.pkg {package_name[[1]]}}) ({length(tag)} tags): {.strong {total_build_time} {units(difftime(Sys.time(), t1))}}.") cli::cli_h2("Uploading ({.pkg {package_name[1]}})") out <- progressr::with_progress({ p <- progressr::progressor(along = tag) future.apply::future_mapply(function(x, y) { tryCatch( { p() dump <- upload_single_binary_to_s3(package_name = x, tag = y, force = force, build_for_minor = build_for_minor, debug = debug) }, error = function(e) { message(sprintf("Error in uploading package %s with tag %s: %s", x, y, e)) } ) }, package_name, tag, future.seed = TRUE) }) cli::cli_h2("Updating package index for package ({.pkg {package_name[1]}})") # add_to_package_index(package_name[1], debug = debug) return(invisible(TRUE)) } #' @importFrom cli cli_alert #' @importFrom pkgbuild build #' @importFrom fs file_size file_move #' @export build_single_tag <- function( package_name, tag = NULL, platform, dir_out_bin, local_clone_dir, debug = FALSE) { cli::cli_alert("{.fun build_single_tag}: (1/3) Cloning package {.pkg {package_name}} with tag {.field {tag}}.") local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, package_name, tag) # Using system git here as {gert} does not provide this functionality to checkout a branch by tag system2("git", args = c( "clone", "-q", sprintf("--branch=%s", tag), sprintf("https://github.com/cran/%s", package_name), local_clone_dir_single )) if (file.exists(sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag))) { cli::cli_alert("{.fun build_single_tag}: (2/3). Tarball for package {.pkg {package_name}} with tag {.field {tag}} already exists. Skipping build.") } else { cli::cli_alert("{.fun build_single_tag}: (2/3). Building package {.pkg {package_name}} with tag {.field {tag}}.") t1 <- Sys.time() dump <- pkgbuild::build( path = sprintf("%s", local_clone_dir_single), binary = TRUE, vignettes = FALSE, dest_path = dir_out_bin, quiet = TRUE ) if (!file.exists(sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag))) { if (debug) { cli::cli_alert_info('{.fun build_single_tag}: Moving package from {.path {sprintf("%s/%s*.tar.gz", dir_out_bin, package_name)}} to {.path {sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag)}}') } # remove _aarch64-unknown-linux-gnu part in filename fs::file_move( sprintf("%s/%s_%s_R_aarch64-unknown-linux-gnu.tar.gz", dir_out_bin, package_name, tag), sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag) ) } else { cli::cli_alert_warning('{.fun build_single_tag}: Binary {sprintf("%s_%s.tar.gz", package_name, tag)} already exists. Skipping copy.') } unlink(sprintf("%s/%s_%s_R*.tar.gz", dir_out_bin, package_name, tag)) cli::cli_alert("{.fun build_single_tag}: (3/3) Removing {.path {local_clone_dir_single}}.") unlink(local_clone_dir_single, force = TRUE, recursive = TRUE) total_build_time <- round(as.numeric(difftime(Sys.time(), t1, units = "secs")), 2) # bytes to MB in binary format file_size <- round(as.numeric(fs::file_size(sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag))) / (1024^2), 2) if (debug) { cli::cli_alert_warning("DEBUG: total_build_time: {total_build_time}") cli::cli_alert_warning("DEBUG: file_size: {file_size}") } # skip DB connection if package already exists if (file.exists(sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag))) { con <- DBI::dbConnect(RPostgres::Postgres(), dbname = "build_metadata", host = "postgres-arm-binaries-r.devxy.io", port = 15432, user = "arm_binaries", password = Sys.getenv("PGPASS") ) dbExecute(con, "UPDATE single_builds SET build_duration = $1, size = $2 WHERE package_name = $3 and platform = $4 and tag = $5", params = list( total_build_time, file_size, package_name, platform, tag ) ) dbDisconnect(con) } } return(invisible(TRUE)) }