My team is having issues installing R packages due to our corporate antivirus software. We are able to temporarily work around the issue by editing the function interactively with the command trace(utils:::unpackPkgZip, edit=TRUE)
(Solution taken from: https://stackoverflow.com/a/46037327/4872343).
I attempted to edit the function (toy example below) using:
myfunc <- function(x)
{
line1 <- x
line2 <- 0
line3 <- line1 + line2
return(line3)
}
as.list(body(f))
body(foo)[[3]] <- substitute(line2 <- 2)
(source: What ways are there to edit a function in R?)
My substitution "line" is significantly more complex (the small change I need to make is part of "line" 14:
if (desc[1L, "Type"] %in% "Translation") {
fp <- file.path(pkgname, "share", "locale")
if (file.exists(fp)) {
langs <- dir(fp)
for (lang in langs) {
path0 <- file.path(fp, lang, "LC_MESSAGES")
mos <- dir(path0, full.names = TRUE)
path <- file.path(R.home("share"), "locale",
lang, "LC_MESSAGES")
if (!file.exists(path))
if (!dir.create(path, FALSE, TRUE))
warning(gettextf("failed to create %s",
sQuote(path)), domain = NA)
res <- file.copy(mos, path, overwrite = TRUE)
if (any(!res))
warning(gettextf("failed to create %s", paste(sQuote(mos[!res]),
collapse = ",")), domain = NA)
}
}
fp <- file.path(pkgname, "library")
if (file.exists(fp)) {
spkgs <- dir(fp)
for (spkg in spkgs) {
langs <- dir(file.path(fp, spkg, "po"))
for (lang in langs) {
path0 <- file.path(fp, spkg, "po", lang, "LC_MESSAGES")
mos <- dir(path0, full.names = TRUE)
path <- file.path(R.home(), "library", spkg,
"po", lang, "LC_MESSAGES")
if (!file.exists(path))
if (!dir.create(path, FALSE, TRUE))
warning(gettextf("failed to create %s",
sQuote(path)), domain = NA)
res <- file.copy(mos, path, overwrite = TRUE)
if (any(!res))
warning(gettextf("failed to create %s",
paste(sQuote(mos[!res]), collapse = ",")),
domain = NA)
}
}
}
}
else {
instPath <- file.path(lib, pkgname)
if (identical(lock, "pkglock") || isTRUE(lock)) {
lockdir <- if (identical(lock, "pkglock"))
file.path(lib, paste0("00LOCK-", pkgname))
else file.path(lib, "00LOCK")
if (file.exists(lockdir)) {
stop(gettextf("ERROR: failed to lock directory %s for modifying\nTry removing %s",
sQuote(lib), sQuote(lockdir)), domain = NA)
}
dir.create(lockdir, recursive = TRUE)
if (!dir.exists(lockdir))
stop(gettextf("ERROR: failed to create lock directory %s",
sQuote(lockdir)), domain = NA)
if (file.exists(instPath)) {
file.copy(instPath, lockdir, recursive = TRUE)
on.exit({
if (restorePrevious) {
try(unlink(instPath, recursive = TRUE))
savedcopy <- file.path(lockdir, pkgname)
file.copy(savedcopy, lib, recursive = TRUE)
warning(gettextf("restored %s", sQuote(pkgname)),
domain = NA, call. = FALSE, immediate. = TRUE)
}
}, add = TRUE)
restorePrevious <- FALSE
}
on.exit(unlink(lockdir, recursive = TRUE), add = TRUE)
}
if (libs_only) {
if (!file_test("-d", file.path(instPath, "libs")))
warning(gettextf("there is no 'libs' directory in package %s",
sQuote(pkgname)), domain = NA, call. = FALSE,
immediate. = TRUE)
for (sub in c("i386", "x64")) if (file_test("-d",
file.path(tmpDir, pkgname, "libs", sub))) {
unlink(file.path(instPath, "libs", sub), recursive = TRUE)
ret <- file.copy(file.path(tmpDir, pkgname,
"libs", sub), file.path(instPath, "libs"),
recursive = TRUE)
if (any(!ret)) {
warning(gettextf("unable to move temporary installation %s to %s",
sQuote(normalizePath(file.path(tmpDir, pkgname,
"libs", sub), mustWork = FALSE)), sQuote(normalizePath(file.path(instPath,
"libs"), mustWork = FALSE))), domain = NA,
call. = FALSE, immediate. = TRUE)
restorePrevious <- TRUE
}
}
fi <- file.info(Sys.glob(file.path(instPath, "libs",
"*")))
dirs <- row.names(fi[fi$isdir %in% TRUE])
if (length(dirs)) {
descfile <- file.path(instPath, "DESCRIPTION")
olddesc <- readLines(descfile)
olddesc <- grep("^Archs:", olddesc, invert = TRUE,
value = TRUE, useBytes = TRUE)
newdesc <- c(olddesc, paste("Archs:", paste(basename(dirs),
collapse = ", ")))
writeLines(newdesc, descfile, useBytes = TRUE)
}
}
else {
ret <- unlink(instPath, recursive = TRUE, force = TRUE)
if (ret == 0) {
Sys.sleep(0.5)
ret <- file.rename(file.path(tmpDir, pkgname),
instPath)
if (!ret) {
warning(gettextf("unable to move temporary installation %s to %s",
sQuote(normalizePath(file.path(tmpDir, pkgname),
mustWork = FALSE)), sQuote(normalizePath(instPath,
mustWork = FALSE))), domain = NA, call. = FALSE,
immediate. = TRUE)
restorePrevious <- TRUE
}
}
else {
warning(gettextf("cannot remove prior installation of package %s",
sQuote(pkgname)), domain = NA, call. = FALSE,
immediate. = TRUE)
restorePrevious <- TRUE
}
}
}
}
I attempted to wrap that block in quotes and assign to a variable name, but got the following error:
Error: unexpected '}' in:
"}
}"
I was able to assign the original code block (antivirus_problem
) and an edited version (antivirus_fix
) to variable names by wrapping them in as.symbol()
or expression()
(both showed up as potential fixes in the answers to the above referenced question).
running the following command resulted in an error:
body(utils:::unpackPkgZip)[[14]] <- substitute(antivirus_problem <- antivirus_fix)
Error in body(utils:::unpackPkgZip)[[14]] <- substitute(antivirus_problem <- antivirus_fix) :
object 'utils' not found
I then attempted to use fixInNamespace()
per Richie Cotton's answer (https://stackoverflow.com/a/8743858/4872343)
but it returned an error as well (also is an interactive fix and I'm looking to do this via scripting without an GUI dependency) :
fixInNamespace("unpackPkgZip", "utils")
Error in assignInNamespace(subx, x, ns) :
locked binding of ‘unpackPkgZip’ cannot be changed
I believe that package namespaces are locked after the package has been loaded, but unloading utils
to edit unpackPkgZip
also unloads fixInNamespace()
.
Given this information is it possible for me to:
- Permanently edit the
unpackPkgZip
function? - Edit the function via a script/non-interactive manner (possibly adding it to our Rprofile.site so that the fix is applied every time someone launches R).
- Override the version of
unpackPkgZip
inutils
and tellutils
to use a fixed version instead.