Nothing
########################################################
# R functions for connection to Gateway Server in Java
# Author: Mathieu Fortin, Canadian Wood Fibre Centre
# Date: January 2019
########################################################
#'
#' Connect to Java environment
#'
#' This function connects the R environment to a gateway server that runs in Java.
#'
#' The first argument of the function provides the listening port for the Java server. A maximum of four ports is
#' allowed. When set to 0, these ports are randomly selected. By default, the server listens to two random
#' ports.
#'
#' The extensionPath can either be set in this function or dynamically changed (see the addToClassPath function).
#'
#' @param port a vector of the listening ports for the Java server
#' @param extensionPath the path to jar files that can be loaded by the system classloader
#' @param memorySize the memory size of the Java Virtual Machine in Mb (if not specified, the JVM runs with the default memory size)
#' @param debug for debugging only (should be left as is)
#'
#' @seealso \code{\link{addToClassPath}}
#'
#' @return a logical TRUE if the function managed to get connected to the server or if it was already connected or
#' FALSE if the connection has failed
#'
#' @export
connectToJava <- function(port = c(0,0), extensionPath = NULL, memorySize = NULL, debug = FALSE) {
if (isConnectedToJava()) {
message("It seems R is already connected to the Java server.")
return(TRUE)
} else {
if (debug) {
if (is.null(port)) {
stop("The port argument cannot be null in debug mode. Please use the ports you specified when you started the server!")
}
assign("connectionHandler", J4RConnectionHandler(port, 1000000, 50000:50001), envir = cacheEnv)
} else {
if (.isVerbose()) {
message(.checkJavaVersionRequirement())
}
message("Starting Java server...")
parms <- c("-firstcall", "true")
if (!is.null(port)) {
if (any(port < 0)) {
stop("Ports should be integers equal to or greater than 0!")
}
if (length(port) > 4) {
stop("J4R allows for a maximum of 4 ports!")
}
parms <- c(parms, "-ports", paste(port,collapse=portSplitter))
}
if (!is.null(extensionPath)) {
parms <- c(parms, "-ext", extensionPath)
}
if (!is.null(memorySize)) {
if (!is.numeric(memorySize) && !is.integer(memorySize)) {
stop("The memorySize parameter should be either a numeric or an integer!")
}
if (memorySize < 50) {
stop("The minimum memory for the JVM is 50 Mb!")
}
parms <- c(parms, "-mem", as.integer(memorySize))
} else if (exists("defaultJVMMemory", envir = settingEnv)) {
memorySize <- get("defaultJVMMemory", envir = settingEnv)
parms <- c(parms, "-mem", as.integer(memorySize))
}
parms <- c(parms, "-wd", getwd())
filename <- file.path(getwd(), "J4RTmpFile")
if (file.exists(filename)) {
file.remove(filename)
}
if (file.exists(system.file("inst", "java", "j4r.jar", package = "J4R"))) { ### test mode
rootPath <- system.file("inst", "java", package = "J4R")
} else { ### normal mode
rootPath <- system.file("java", package = "J4R")
}
# message(rootPath)
architecture <- suppressMessages(getJavaVersion()$architecture)
if (architecture == "32-Bit") {
jarFilename <- "j4r_x86.jar"
message("Running the 32-Bit version")
} else {
jarFilename <- "j4r.jar"
}
path <- file.path(rootPath, jarFilename)
system2(.getJavaPath(), args = c("-Xmx50m", "-jar", path, parms), wait = F)
initialTime <- Sys.time()
while (!file.exists(filename)) {
Sys.sleep(0.5)
elapsedTime <- Sys.time() - initialTime
if (elapsedTime > 8) {
stop("It seems the server has failed to start!")
}
}
.instantiateConnectionHandler()
}
isSecure <- .createAndSecureConnection()
# if (!isSecure) {
# shutdownJava() ### for a clean exit
# }
return(isSecure)
}
}
.instantiateConnectionHandler <- function() {
info <- suppressWarnings(utils::read.table("J4RTmpFile", header=F, sep=";", stringsAsFactors = F))
key <- as.integer(info[1,1])
internalports <- as.integer(strsplit(info[1,2], split = portSplitter)[[1]])
if (is.integer(info[1,3])) { ### happens with a single port
port <- as.integer(info[1,3])
} else {
port <- as.integer(strsplit(info[1,3], split = portSplitter)[[1]])
}
assign("connectionHandler", J4RConnectionHandler(port, key, internalports), envir = cacheEnv)
}
#'
#' Checks if the Java server is running
#'
#' This is done by checking f the socket connection to the JVM exists.
#'
#' @return a logical
#'
#' @export
isConnectedToJava <- function() {
if (exists("connectionHandler", envir = cacheEnv)) {
stillConnected <- .isThereAtLeastOneConnection(get("connectionHandler", envir = cacheEnv))
return(stillConnected)
} else {
return(FALSE)
}
}
#'
#' The number of connections to the server
#'
#' @return the number of sockets connected to the server
#'
#' @export
getNbConnections <- function() {
if (exists("connectionHandler", envir = cacheEnv)) {
return(length(get("connectionHandler", envir = cacheEnv)$connections))
} else {
return(0)
}
}
#'
#' Shut down Java
#'
#' This function shuts down Java and the gateway server.
#'
#' @seealso \href{https://sourceforge.net/p/repiceasource/wiki/J4R/}{J4R webpage}
#'
#' @export
shutdownJava <- function() {
.softExit()
}
.internalShutdown <- function() {
if (isConnectedToJava()) {
for (aff in 1:getNbConnections()) {
utils::write.socket(.getSocket(affinity = aff), "closeConnection")
utils::close.socket(.getSocket(affinity = aff))
}
utils::write.socket(.getGCSocket(), "closeConnection")
utils::close.socket(.getGCSocket())
message("Closing connections and removing sockets...")
}
if (exists("connectionHandler", envir = cacheEnv)) { # when security is not validated, the connectionhandler object remains
rm("connectionHandler", envir = cacheEnv)
}
if (exists("dumpPile", envir = cacheEnv)) {
rm("dumpPile", envir = cacheEnv)
}
if (exists("classMap", envir = cacheEnv)) {
rm("classMap", envir = cacheEnv)
}
filename <- file.path(getwd(), "J4RTmpFile")
if (file.exists(filename)) {
file.remove(filename)
}
#### Remove because CRAN policy is to leave the global environment untouched
# nbObjectRemoved <- 0
# for (objectName in ls(envir = globalenv())) {
# # if ("java.object" %in% class(object)) {
# if (.getClass(get(objectName, envir = globalenv())) %in% c("java.object", "java.list")) {
# nbObjectRemoved <- nbObjectRemoved + 1
# if (nbObjectRemoved == 1) {
# message("Removing Java objects from global environment...")
# }
# rm(list = objectName, envir = globalenv())
# }
# }
}
#'
#' Synchronize the Java environment with the R environment
#'
#' This function call the garbage collector in R and sends the list of Java references
#' that have been collected to the Java server. These references are then removed from
#' the internal map.
#'
#' @seealso \href{https://sourceforge.net/p/repiceasource/wiki/J4R/}{J4R webpage}
#'
#' @export
callJavaGC <- function() {
gc()
.flushDumpPileIfNeeded(1)
}
.flush <- function(javaList) {
prefix <- "flush"
maxLength <- length(javaList)
nbCalls <- ceiling(maxLength / maxVectorLength)
output <- NULL
for (i in 1:nbCalls) {
lowerIndex <- (i-1) * maxVectorLength + 1
upperIndex <- i * maxVectorLength
if (upperIndex > maxLength) {
upperIndex <- maxLength
}
subList <- javaList[lowerIndex:upperIndex]
subcommands <- paste("java.object",.translateJavaObject(subList),sep="")
command <- paste(prefix, subcommands, sep=MainSplitter)
utils::write.socket(.getGCSocket(), command)
callback <- utils::read.socket(.getGCSocket(), maxlen=bufferLength)
output <- .processResult(callback, output)
}
if (!is.null(output)) {
stop("The Java server has returned something else than NULL!")
return(output)
} else {
return(invisible(output))
}
}
#' Return the number of instances stored in the
#' internal map of the Java server
#'
#' @return an integer
#'
#' @export
getNbInstancesInInternalMap <- function() {
command <- "size"
utils::write.socket(.getSocket(), command)
callback <- utils::read.socket(.getSocket(), maxlen=bufferLength)
return(.processCallback(callback))
}
#'
#' Retrieve the paths of the current classloader
#'
#' This functions returns the paths that are currently included
#' in the System classloader.
#'
#' @export
getClassLoaderPaths <- function() {
paths <- callJavaMethod("j4r.lang.J4RSystem", "getClassPathURLs")
pathsList <- getAllValuesFromListObject(paths)
return(pathsList)
}
#'
#' Retrieve the URLs of the current classloader
#'
#' This function returns the URLs that are currently included
#' in the System classloader.
#'
#' This function is deprecated. Please use the getClassLoaderPaths instead.
#'
#' @export
getClassLoaderURLs <- function() {
.Deprecated("getClassLoaderPaths")
return(getClassLoaderPaths())
}
#'
#' Check if a Library has been loaded
#'
#' It checks if a particular library is part of the classpath.
#'
#' @param myJavaLibrary a character string that stands for the java library (e.g. repicea.jar)
#'
#' @export
checkIfClasspathContains <- function(myJavaLibrary) {
if (isConnectedToJava()) {
listURLs <- getClassLoaderPaths()
isLibIn <- FALSE
if (length(listURLs) > 1) {
for (i in 1:length(listURLs)) {
if (grepl(myJavaLibrary, listURLs[i])) {
isLibIn <- TRUE
break
}
}
} else {
isLibIn <- grepl(myJavaLibrary, listURLs)
}
return(isLibIn)
} else {
message("The Java server is not running.")
}
}
.getLibraryPath <- function(packageName, myJavaLibrary) {
filename <- system.file("inst", myJavaLibrary, package = packageName)
if (file.exists(filename)) { ### test mode
filePath <- filename
} else {
filename <- system.file(myJavaLibrary, package = packageName)
if (file.exists(filename)) { ### normal mode
filePath <- filename
} else {
filePath <- NULL
}
}
return(filePath)
}
#'
#' Force the JVM to shut down
#'
#' This is the not so gentle way to exit the JVM.
#'
#' In case the JVM is stuck and does not respond to interrupt. It is possible
#' to force the shutdown through this function.
#'
#' @export
killJava <- function() {
tryCatch(
{
emergencySocket <- .getBackdoorSocket()
utils::write.socket(socket = emergencySocket, "emergencyShutdown")
utils::close.socket(emergencySocket)
},
error=function(cond) {
message("Unable to connect the server. It might be already down!")
}
)
.internalShutdown()
Sys.sleep(2) ### wait two seconds to make sure the server is really shut down
message("Done.")
}
#'
#' Interrupt the current task on the Java server
#'
#'
#' @export
interruptJava <- function() {
tryCatch(
{
emergencySocket <- .getBackdoorSocket()
utils::write.socket(socket = emergencySocket, "interrupt")
invisible(utils::close.socket(emergencySocket))
},
error=function(cond) {
message("Unable to connect to the server. It might be already down!")
}
)
}
.softExit <- function() {
tryCatch(
{
emergencySocket <- .getBackdoorSocket()
utils::write.socket(socket = emergencySocket, "softExit")
utils::close.socket(emergencySocket)
},
error=function(cond) {
message("Unable to connect the server. It might be already down!")
}
)
.internalShutdown()
Sys.sleep(2) ### wait two seconds to make sure the server is really shut down
message("Done.")
}
#'
#' Dynamically adds a path or a jar file to the classpath.
#'
#' This function makes it possible to add a directory or a JAR file
#' to the class path. If the packageName parameter is null then the urlString
#' parameter must be the complete path to the directory. Otherwise, it can be
#' the name of the JAR file and the function will find the path through the package
#' name. A non null packageName parameter is typically used in packages that rely
#' on J4R.
#'
#' @param path a character representing the path to the directory or the JAR file
#' if the packageName parameter is null. Otherwise, it can just be the name of the JAR file. This path
#' is normalized so that expressions like myJar.jar or ./extensions/myJar.jar will be processed.
#' @param packageName a character representing the package.
#'
#' @export
addToClassPath <- function(path, packageName = NULL) {
if (isConnectedToJava()) {
if (!is.null(packageName)) {
path <- .getLibraryPath(packageName, path)
}
callJavaMethod("j4r.lang.J4RSystem", "addToClassPath", normalizePath(path))
} else {
message("The Java server is not running.")
}
}
#'
#' Dynamically adds an url to the classpath.
#'
#' This function makes it possible to add a directory or a JAR file
#' to the class path. If the packageName parameter is null then the urlString
#' parameter must be the complete path to the directory. Otherwise, it can be
#' the name of the JAR file and the function will find the path through the package
#' name. A non null packageName parameter is typically used in packages that rely
#' on J4R.
#'
#' This function is deprecated. Use the addToClassPath function instead.
#'
#' @param urlString a character representing the complete path to the directory or the JAR file
#' if the packageName parameter is null. Otherwise, it can just be the name of the JAR file.
#' @param packageName a character representing the package.
#'
#' @export
addUrlToClassPath <- function(urlString, packageName = NULL) {
.Deprecated("addToClassPath")
addToClassPath(urlString, packageName)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.