[Sciviews-commits] r302 - in pkg/svSocket: . R man testCLI
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Sep 11 08:59:30 CEST 2010
Author: phgrosjean
Date: 2010-09-11 08:59:30 +0200 (Sat, 11 Sep 2010)
New Revision: 302
Added:
pkg/svSocket/man/svSocket-package.Rd
Modified:
pkg/svSocket/DESCRIPTION
pkg/svSocket/NEWS
pkg/svSocket/R/closeSocketClients.R
pkg/svSocket/R/evalServer.R
pkg/svSocket/R/getSocket.R
pkg/svSocket/R/parSocket.R
pkg/svSocket/R/processSocket.R
pkg/svSocket/R/sendSocketClients.R
pkg/svSocket/R/startSocketServer.R
pkg/svSocket/R/stopSocketServer.R
pkg/svSocket/R/svSocket-Internal.R
pkg/svSocket/R/svTaskCallbackManager.R
pkg/svSocket/TODO
pkg/svSocket/man/closeSocketClients.Rd
pkg/svSocket/man/evalServer.Rd
pkg/svSocket/man/getSocketClients.Rd
pkg/svSocket/man/getSocketServerName.Rd
pkg/svSocket/man/getSocketServers.Rd
pkg/svSocket/man/parSocket.Rd
pkg/svSocket/man/processSocket.Rd
pkg/svSocket/man/sendSocketClients.Rd
pkg/svSocket/man/startSocketServer.Rd
pkg/svSocket/man/svTaskCallbackManager.Rd
pkg/svSocket/testCLI/testCLI.R
pkg/svSocket/testCLI/testCLIcmd.R
Log:
processSocket() now call parseText() instead of Parse() in svMisc >= 0.9-60.
Added a svSocket-package help page.
Modified: pkg/svSocket/DESCRIPTION
===================================================================
--- pkg/svSocket/DESCRIPTION 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/DESCRIPTION 2010-09-11 06:59:30 UTC (rev 302)
@@ -2,11 +2,11 @@
Type: Package
Title: SciViews GUI API - R Socket Server
Depends: R (>= 2.6.0)
-Imports: tcltk, svMisc
+Imports: tcltk, svMisc (>= 0.9-60)
Description: Implements a simple socket server allowing to connect GUI clients to R
-Version: 0.9-49
-Date: 2010-08-31
-Author: Philippe Grosjean, Matthew Dowle
+Version: 0.9-50
+Date: 2010-10-11
+Author: Philippe Grosjean & Matthew Dowle
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
LazyLoad: yes
Modified: pkg/svSocket/NEWS
===================================================================
--- pkg/svSocket/NEWS 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/NEWS 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,5 +1,10 @@
= svSocket News
+== Changes in svSocket 0.9-50
+
+* processSocket() now calls parseText() from svMisc >= 0.9-60 instead of Parse().
+
+
== Changes in svSocket 0.9-49
* Small change in startSocketServer(): the Tcl/Tk callback function now calls
Modified: pkg/svSocket/R/closeSocketClients.R
===================================================================
--- pkg/svSocket/R/closeSocketClients.R 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/R/closeSocketClients.R 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,7 +1,7 @@
closeSocketClients <- function (sockets = "all", serverport = 8888)
{
- # Nicely close socket client(s) by sending "\f"
- # To be interpreted by a compatible client that manages to close connection
+ ## Nicely close socket client(s) by sending "\f"
+ ## To be interpreted by a compatible client that manages to close connection
if (sockets == "all")
sockets <- getSocketClientsNames(port = serverport)
if (!is.null(sockets) && length(sockets) > 0)
Modified: pkg/svSocket/R/evalServer.R
===================================================================
--- pkg/svSocket/R/evalServer.R 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/R/evalServer.R 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,31 +1,31 @@
evalServer <- function (con, expr, send = NULL)
{
- # Evaluate expr on the R server, and return its value
- # con as returned by socketConnection(port = 8888)
- # send is optional. If supplied, expr must be a single unquoted object name.
- # Then send is evaluated on the client and the result is assigned
- # to that object on the server.
- # Robust flushing and dumping is just for windows. Linux is probably fine
- # without but no harm to leave in for now since binary mode will moot this.
+ ## Evaluate expr on the R server, and return its value
+ ## con as returned by socketConnection(port = 8888)
+ ## send is optional. If supplied, expr must be a single unquoted object name.
+ ## Then send is evaluated on the client and the result is assigned
+ ## to that object on the server.
+ ## Robust flushing and dumping is just for windows. Linux is probably fine
+ ## without but no harm to leave in for now since binary mode will moot this.
x <- substitute(expr)
if (!missing(send) && (!length(x) == 1 || mode(x) != "name"))
stop("When send is supplied, expr must be a target variable name (unquoted) on the server to assign the result of the send expr to.")
if (!is.character(x)) x <- deparse(x)
- readLines(con) # flush input stream just incase previous call failed to clean up.
+ readLines(con) # Flush input stream just incase previous call failed to clean up.
if (missing(send)) {
cat('..Last.value <- try(eval(parse(text = "', x,
'"))); .f <- file(); dump("..Last.value", file = .f); flush(.f); seek(.f, 0); cat("\\n<<<startflag>>>", readLines(.f), "<<<endflag>>>\\n", sep = "\\n"); close(.f); rm(.f, ..Last.value); flush.console()\n',
file = con, sep = "")
- # It is important that one line only is written, so that other clients
- # don't mix in with these lines.
+ ## It is important that one line only is written, so that other clients
+ ## don't mix in with these lines.
} else {
.f <- file()
on.exit(close(.f))
..Last.value <- send
- # dump can stop prematurely if file=con, but also good to remove the /n
- # from dump's output before sending (to avoid possible conflicts with
- # other clients)
+ ## dump() can stop prematurely if file=con, but also good to remove the /n
+ ## from dump()'s output before sending (to avoid possible conflicts with
+ ## other clients)
dump("..Last.value", file <- .f)
flush(.f)
seek(.f, 0)
@@ -37,16 +37,16 @@
endloc <- NULL
while (!length(endloc)) {
obj <- readLines(con, n = 1000, warn = FALSE)
- # Wait for data to come back. Without this sleep, you get 20-30 calls
- # to readLines before data arrives.
+ ## Wait for data to come back. Without this sleep, you get 20-30 calls
+ ## to readLines before data arrives.
if (!length(obj)) {
Sys.sleep(0.01)
next
}
endloc <- grep("<<<endflag>>>", obj)
if (length(endloc)) obj <- obj[0:(endloc - 1)]
- # This is more robust than paste'ing together a potentially very
- # large single string.
+ ## This is more robust than paste'ing together a potentially very
+ ## large single string.
objdump <- c(objdump, obj)
}
if (!missing(send)) {
@@ -56,16 +56,16 @@
start <- grep("<<<startflag>>>", objdump)
if (length(start) != 1)
stop("Unable to find <<<startflag>>>")
- # The startflag is because sometimes (strangely rarely) seek, flush and dump
- # can write return value to stdout which do not source.
+ ## The startflag is because sometimes (strangely rarely) seek, flush and dump
+ ## can write return value to stdout which do not source.
objdump <- objdump[-(1:start)]
- # Fix any output buffer wrap issues. There are line breaks mid number
- # sometimes which don't source.
- # This is why warn = FALSE appears above in the call to readLines since it
- # warns about these noncomplete lines otherwise.
+ ## Fix any output buffer wrap issues. There are line breaks mid number
+ ## sometimes which don't source.
+ ## This is why warn = FALSE appears above in the call to readLines since it
+ ## warns about these noncomplete lines otherwise.
nospace <- grep("[^ ]$", objdump)
nospace <- nospace[nospace < length(objdump)]
- for (i in rev(nospace)) { # Robust to consecutive lines to be joined
+ for (i in rev(nospace)) { # Robust to consecutive lines to be joined
objdump[i] <- paste(objdump[i], objdump[i + 1], sep = "")
objdump[i + 1] <- ""
}
Modified: pkg/svSocket/R/getSocket.R
===================================================================
--- pkg/svSocket/R/getSocket.R 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/R/getSocket.R 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,6 +1,6 @@
getSocketServers <- function ()
{
- # Get the list of currently running socket servers
+ ## Get the list of currently running socket servers
return(TempEnv()$SocketServers)
}
@@ -11,20 +11,20 @@
portnum <- round(port[1])
port <- as.character(portnum)
- # Does a server exists on this port?
+ ## Does a server exist on this port?
servers <- getSocketServers()
if (!(port %in% servers))
- return(NULL) # If no R socket server running on this port
+ return(NULL) # If no R socket server running on this port
- # Get the list of clients currently connected to this server
+ ## Get the list of clients currently connected to this server
clients <- as.character(.Tcl(paste("array names Rserver", port, sep = "_")))
- # Eliminate "main", which is the connection socket
+ ## Eliminate "main", which is the connection socket
clients <- clients[clients != "main"]
- # Are there client connected?
+ ## Are there client connected?
if (length(clients) == 0) return(character(0))
- # For each client, retrieve its address and port
+ ## For each client, retrieve its address and port
addresses <- NULL
arrayname <- paste("Rserver", port, sep = "_")
for (i in 1:length(clients)) {
@@ -45,10 +45,10 @@
portnum <- round(port[1])
port <- as.character(portnum)
- # Return the name of a given R socket server
+ ## Return the name of a given R socket server
servers <- getSocketServers()
if (!(port %in% servers))
- return(NULL) # If no R socket server running on this port
+ return(NULL) # If no R socket server running on this port
ServerNames <- names(servers)
return(ServerNames[servers == port])
Modified: pkg/svSocket/R/parSocket.R
===================================================================
--- pkg/svSocket/R/parSocket.R 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/R/parSocket.R 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,11 +1,10 @@
parSocket <- function (client, serverport = 8888, ...)
{
- # Set or get parameters for a given socket client
- # No attempt is made to make sure this client exists
+ ## Set or get parameters for a given socket client
+ ## No attempt is made to make sure this client exists
sc <- paste("SocketClient", client, sep = "_")
- if (!exists(sc, envir = TempEnv(), inherits = FALSE,
- mode = "environment")) {
- # Create a new environment with default values
+ if (!exists(sc, envir = TempEnv(), inherits = FALSE, mode = "environment")) {
+ ## Create a new environment with default values
e <- new.env(parent = TempEnv())
e$client <- client
e$serverport <- serverport
@@ -17,27 +16,29 @@
e$flag <- FALSE # Do not flag pieces of code (not used yet!)
e$multiline <- TRUE # Allow for multiline code
e$bare <- TRUE # Always start in "bare" mode
- # Note: in bare mode, all other parameters are inactive!
- # and assign it to TempEnv
+ ## Note: in bare mode, all other parameters are inactive!
+ ## Assign it to TempEnv
assign(sc, e, envir = TempEnv())
} else e <- get(sc, envir = TempEnv(), mode = "environment")
- # Change or add parameters if they are provided
+ ## Change or add parameters if they are provided
args <- list(...)
if (l <- length(args)) {
change.par <- function (x, val, env) {
- if (is.null(x)) return(FALSE) # Do nothing without a valid name
+ if (is.null(x)) return(FALSE) # Do nothing without a valid name
if (is.null(val)) {
- suppressWarnings(rm(list = x, envir = env)) # Remove it
+ suppressWarnings(rm(list = x, envir = env)) # Remove it
return(TRUE)
}
- env[[x]] <- val # Add or change this variable in the environment
+ env[[x]] <- val # Add or change this variable in the environment
return(TRUE)
}
n <- names(args)
res <- rep(TRUE, l)
- for (i in seq_len(l)) res[i] <- change.par(n[i], args[[i]], e)
- if (any(!res)) warning("Non named arguments are ignored")
+ for (i in seq_len(l))
+ res[i] <- change.par(n[i], args[[i]], e)
+ if (any(!res))
+ warning("Non named arguments are ignored")
}
- # Return e invisibly
+ ## Return e invisibly
return(invisible(e))
}
Modified: pkg/svSocket/R/processSocket.R
===================================================================
--- pkg/svSocket/R/processSocket.R 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/R/processSocket.R 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,77 +1,77 @@
processSocket <- function (msg, socket, serverport, ...)
{
- # This is the default R function that processes a command send by a socket
- # client. 'msg' is assumed to be R code contained in a string
+ ## This is the default R function that processes a command send by a socket
+ ## client. 'msg' is assumed to be R code contained in a string
- # Do we receive a <<<id=myID>>> sequence?
+ ## Do we receive a <<<id=myID>>> sequence?
if (regexpr("^<<<id=[a-zA-Z0-9]+>>>", msg) > 0) {
- # get the identifier
+ ## Get the identifier
client <- sub("^<<<id=([a-zA-Z0-9]+)>>>.*$", "\\1", msg)
- # and eliminate that sequence
+ ## ... and eliminate that sequence
msg <- sub("^<<<id=[a-zA-Z0-9]+>>>", "", msg)
} else {
- # The client name is simply the socket name
+ ## The client name is simply the socket name
client <- socket
}
- # Do we receive <<<esc>>>? => break (currently, only break multiline mode)
+ ## Do we receive <<<esc>>>? => break (currently, only break multiline mode)
if (substr(msg, 1, 9) == "<<<esc>>>") {
- pars <- parSocket(client, serverport, code = "") # Reset multiline code
+ pars <- parSocket(client, serverport, code = "") # Reset multiline code
msg <- substr(msg, 10, 1000000)
}
- # Replace <<<n>>> by \n (for multiline code)
+ ## Replace <<<n>>> by \n (for multiline code)
msg <- gsub("<<<n>>>", "\n", msg)
- # Replace <<<s>>> by the corresponding client identifier and server port
+ ## Replace <<<s>>> by the corresponding client identifier and server port
msg <- gsub("<<<s>>>", paste('"', client, '", ', serverport, sep = ""), msg)
hiddenMode <- FALSE
returnResults <- TRUE
- # If msg starts with <<<Q>>> or <<<q>>>, then disconnect server before or
- # after evaluation of the command, respectively
- # If msg starts with <<<e>>>, evaluate command in the console and disconnect
- # If msg starts with <<<h>>> or <<<H>>>, evaluate in hidden mode and disconnect
+ ## If msg starts with <<<Q>>> or <<<q>>>, then disconnect server before or
+ ## after evaluation of the command, respectively
+ ## If msg starts with <<<e>>>, evaluate command in the console and disconnect
+ ## If msg starts with <<<h>>> or <<<H>>>, evaluate in hidden mode and disconnect
startmsg <- substr(msg, 1, 7)
if (startmsg == "<<<Q>>>") {
msg <- substr(msg, 8, 1000000)
- # Indicate to the client that he can disconnect now
+ ## Indicate to the client that he can disconnect now
closeSocketClients(sockets = socket, serverport = serverport)
returnResults <- FALSE
} else if (startmsg == "<<<q>>>") {
msg <- substr(msg, 8, 1000000)
- # Remember to indicate disconnection at the end
+ ## Remember to indicate disconnection at the end
parSocket(client, serverport, last = "\n\f")
} else if (startmsg == "<<<e>>>") {
msg <- substr(msg, 8, 1000000)
- # We just configure the server correctly
+ ## We just configure the server correctly
parSocket(client, serverport, bare = FALSE, echo = TRUE,
prompt = ":> ", continue = ":+ ",
multiline = TRUE, last = "\n\f")
- # Add a command to the command history
+ ## Add a command to the command history
#timestamp("my R command", "", "", quiet = TRUE)
} else if (startmsg == "<<<h>>>") {
msg <- substr(msg, 8, 1000000)
- # Do not echo command on the server (silent execution)
+ ## Do not echo command on the server (silent execution)
hiddenMode <- TRUE
parSocket(client, serverport, bare = TRUE, last = "\n\f")
} else if (startmsg == "<<<H>>>") {
msg <- substr(msg, 8, 1000000)
- # Do not echo command on the server (silent execution with no return)
+ ## Do not echo command on the server (silent execution with no return)
closeSocketClients(sockets = socket, serverport = serverport)
hiddenMode <- TRUE
returnResults <- FALSE
parSocket(client, serverport, bare = TRUE)
} else if (startmsg == "<<<u>>>") {
msg <- substr(msg, 8, 1000000)
- # Silent execution, nothing is returned to the client
- # (but still echoed to the server)
+ ## Silent execution, nothing is returned to the client
+ ## (but still echoed to the server)
hiddenMode <- FALSE
returnResults <- FALSE
parSocket(client, serverport, bare = TRUE)
}
- # Get parameters for the client
+ ## Get parameters for the client
pars <- parSocket(client, serverport)
if (Bare <- pars$bare) {
Prompt <- ""
@@ -87,29 +87,29 @@
if (pars$code == "") Pre <- Prompt else Pre <- Continue
cat(Pre, msg, "\n", sep = "")
}
- # Add previous content if we were in multiline mode
+ ## Add previous content if we were in multiline mode
msg <- paste(pars$code, msg, sep = "\n")
- pars$code <- "" # This changes the original data too!
+ pars$code <- "" # This changes the original data too!
}
- # Parse the R code
- expr <- Parse(msg)
- # Is it a wrong code?
+ ## Parse the R code
+ expr <- parseText(msg)
+ ## Is it a wrong code?
if (inherits(expr, "try-error")) {
res <- paste(ngettext(1, "Error: ", "", domain = "R"),
sub("^[^:]+: ([^\n]+)\n[0-9]+:(.*)$", "\\1\\2", expr), sep = "")
if (Echo) cat(res)
return(paste(res, pars$last, Prompt, sep = ""))
}
- # Is it incomplete code?
+ ## Is it incomplete code?
if (!is.expression(expr)) {
- # Is multiline mode allowed?
+ ## Is multiline mode allowed?
if (!Bare && pars$multiline) {
pars$code <- msg
if (returnResults) {
return(paste(pars$last, Continue, sep = ""))
} else return("")
- } else { # Multimode not allowed
+ } else { # Multimode not allowed
res <- paste(gettext("Error: incomplete command in single line mode"),
"\n", sep = "")
if (Echo) cat(res)
@@ -118,18 +118,18 @@
} else return("")
}
}
- # Freeze parameters (unlinks from the environment)
+ ## Freeze parameters (unlinks from the environment)
pars <- as.list(pars)
- # Is it something to evaluate?
+ ## Is it something to evaluate?
if (length(expr) < 1) return(paste(pars$last, Prompt, sep = ""))
- # Correct code,... we evaluate it
+ ## Correct code,... we evaluate it
results <- captureAll(expr)
- # Should we run taskCallbacks?
+ ## Should we run taskCallbacks?
if (!hiddenMode) {
h <- getTemp(".svTaskCallbackManager", default = NULL, mode = "list")
if (!is.null(h)) h$evaluate()
}
- # Collapse and add last and the prompt at the end
+ ## Collapse and add last and the prompt at the end
results <- paste(results, collapse = "\n")
if (Echo) cat(results)
if (!returnResults) return("")
Modified: pkg/svSocket/R/sendSocketClients.R
===================================================================
--- pkg/svSocket/R/sendSocketClients.R 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/R/sendSocketClients.R 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,13 +1,13 @@
sendSocketClients <- function (text, sockets = "all", serverport = 8888)
{
- # Note that 'real' clients should manage to print this BEFORE the current
- # command line, something that 'SimpleClient.Tcl' cannot do!
+ ## Note that 'real' clients should manage to print this BEFORE the current
+ ## command line, something that 'SimpleClient.Tcl' cannot do!
- # Make sure that the text ends with a carriage return
- # (same behavior as in Mac R.app but different from RGui!)
+ ## Make sure that the text ends with a carriage return
+ ## (same behavior as in Mac R.app but different from RGui!)
if (regexpr("\n^", text) < 0) text <- paste(text, "\n", sep = "")
- # Send the given text to one or more clients through a socket
+ ## Send the given text to one or more clients through a socket
if (sockets == "all")
sockets <- getSocketClientsNames(port = serverport)
if (!is.null(sockets) && length(sockets) > 0)
Modified: pkg/svSocket/R/startSocketServer.R
===================================================================
--- pkg/svSocket/R/startSocketServer.R 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/R/startSocketServer.R 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,18 +1,18 @@
startSocketServer <- function (port = 8888, server.name = "Rserver",
procfun = processSocket, secure = FALSE, local = !secure)
{
- # OK, could be port = 80 to emulate a simple HTML server
- # This is the main function that starts the server
- # This function implements a basic R socket server on 'port'
- # SocketServerProc is the R workhorse function that do the computation
- # The server is written in Tcl. This way it is not blocking R command-line!
- # It is designed in a way that R can open simultaneously several ports and
- # accept connection from multiple clients to each of them.
- # Commands from each port can be processed differently
+ ## OK, could be port = 80 to emulate a simple HTML server
+ ## This is the main function that starts the server
+ ## This function implements a basic R socket server on 'port'
+ ## SocketServerProc is the R workhorse function that do the computation
+ ## The server is written in Tcl. This way it is not blocking R command-line!
+ ## It is designed in a way that R can open simultaneously several ports and
+ ## accept connection from multiple clients to each of them.
+ ## Commands from each port can be processed differently
- # Secure server requires the tcl-tls package!
+ ## Secure server requires the tcl-tls package!
if (isTRUE(secure)) {
- # TODO: On Mac with AquaTclTk installed, I need: addTclPath("/System/Library/Tcl")
+ ## TODO: On Mac with AquaTclTk installed, I need: addTclPath("/System/Library/Tcl")
res <- tclRequire("tls")
if (!inherits(res, "tclObj"))
stop("You must install the tcl-tls package for using a secure server!")
@@ -21,9 +21,9 @@
if (!is.function(procfun))
stop("'procfun' must be a function!")
- # Note: the data send by the client is in the Tcl $::sockMsg variable
- # Could a clash happen here if multiple clients send data at the
- # same time to the R socket server???
+ ## Note: the data send by the client is in the Tcl $::sockMsg variable
+ ## Could a clash happen here if multiple clients send data at the
+ ## same time to the R socket server???
if (!is.numeric(port[1]) || port[1] < 1)
stop("'port' must be a positive integer!")
portnum <- round(port[1])
@@ -33,43 +33,43 @@
stop("'server.name' must be a string!")
server.name <- as.character(server.name)[1]
- # Check if the port is not open yet
+ ## Check if the port is not open yet
servers <- getSocketServers()
- if (port %in% servers) return(TRUE) # This port is already open!
+ if (port %in% servers) return(TRUE) # This port is already open!
- # We need Tcl to be able to call an R function to process clients' requests
+ ## We need Tcl to be able to call an R function to process clients' requests
"tclProcExists" <- function (proc) {
proc <- as.character(proc[1])
return(length(as.character(tcl("info", "commands", proc))) == 1)
}
if (!tclProcExists("SocketServerProc")) {
- # Create the callback when a client sends data
+ ## Create the callback when a client sends data
"SocketServerFun" <- function () {
- # Note: I don't know how to pass arguments here.
- # So, I use Tcl global variables instead:
- # - the server port from $::sockPort,
- # - the socket client from $::sockClient,
- # - and the message from $::sockMsg
+ ## Note: I don't know how to pass arguments here.
+ ## So, I use Tcl global variables instead:
+ ## - the server port from $::sockPort,
+ ## - the socket client from $::sockClient,
+ ## - and the message from $::sockMsg
"tclGetValue_" <- function (name) {
- # Get the value stored in a plain Tcl variable
+ ## Get the value stored in a plain Tcl variable
if (!is.character(name)) stop("'name' must be a character!")
- # Create a temporary dual variable with tclVar()
+ ## Create a temporary dual variable with tclVar()
Temp <- tclVar(init = "")
- # Copy the content of the var of interest to it
+ ## Copy the content of the var of interest to it
.Tcl(paste("catch {set ", as.character(Temp), " $", name, "}",
sep = ""))
- # Get the content of the temporary variable
+ ## Get the content of the temporary variable
Res <- tclvalue(Temp) # Temp is destroyed when function exists
return(Res)
}
"TempEnv_" <- function () {
pos <- match("TempEnv", search())
- if (is.na(pos)) { # Must create it
+ if (is.na(pos)) { # Must create it
TempEnv <- list()
attach(TempEnv, pos = length(search()) - 1)
rm(TempEnv)
@@ -83,34 +83,34 @@
inherits = FALSE)) {
return(get(x, envir = TempEnv_(), mode = mode,
inherits = FALSE))
- } else { # Variable not found, return the default value
+ } else { # Variable not found, return the default value
return(default)
}
}
"process" <- function () {
port <- tclGetValue_("::sockPort")
- if (port == "") return(FALSE) # The server is closed
+ if (port == "") return(FALSE) # The server is closed
client <- tclGetValue_("::sockClient")
- if (client == "") return(FALSE) # The socket client is unknown!
+ if (client == "") return(FALSE) # The socket client is unknown!
msg <- tclGetValue_("::sockMsg")
- if (msg == "") return(FALSE) # No message!
+ if (msg == "") return(FALSE) # No message!
- # Make sure this message is not processed twice
+ ## Make sure this message is not processed twice
.Tcl("set ::sockMsg {}")
- # Do we have to debug socket transactions
+ ## Do we have to debug socket transactions
Debug <- isTRUE(getOption("debug.Socket"))
if (Debug) cat(client, " > ", port, ": ", msg, "\n", sep = "")
- # Function to process the client request: SocketServerProc_<port>
+ ## Function to process the client request: SocketServerProc_<port>
proc <- getTemp_(paste("SocketServerProc", port, sep = "_"),
mode = "function")
if (is.null(proc) || !is.function(proc))
- return(FALSE) # The server should be closed
- # Call this function
+ return(FALSE) # The server should be closed
+ ## Call this function
res <- proc(msg, client, port)
- # Return result to the client
+ ## Return result to the client
if (res != "") {
if (Debug) cat(port, " > ", client, ": ", res, "\n", sep = "")
chk <- try(tcl("puts", client, res), silent = TRUE)
@@ -119,25 +119,25 @@
return(FALSE)
}
}
- return(TRUE) # The command is processed
+ return(TRUE) # The command is processed
}
- return(process) # Create the closure function for .Tcl.callback()
+ return(process) # Create the closure function for .Tcl.callback()
}
assignTemp("SocketServerProc", SocketServerFun())
- # Create a Tcl proc that calls this function back
+ ## Create a Tcl proc that calls this function back
res <- .Tcl.callback(getTemp("SocketServerProc"), TempEnv())
if (length(grep("R_call ", res) > 0)) {
- # Create a proc with the same name in Tcl
+ ## Create a proc with the same name in Tcl
.Tcl(paste("proc SocketServerProc {} {", res, "}", sep = ""))
} else stop("Cannot create the SciViews socket server callback function")
}
- # Copy procfun into TempEnv as SocketServerProc_<port>
+ ## Copy procfun into TempEnv as SocketServerProc_<port>
assign(paste("SocketServerProc", port, sep ="_"), procfun, envir = TempEnv())
- # Create the Tcl function that retrieves data from the socket
- # (command send by the client), call the processing R function
- # and returns result to the client
+ ## Create the Tcl function that retrieves data from the socket
+ ## (command send by the client), call the processing R function
+ ## and returns result to the client
cmd <- paste(c(paste("proc sockHandler_", port, " {sock} {", sep = ""),
paste("global Rserver_", port, sep = ""),
"if {[eof $sock] == 1 || [catch {gets $sock line}]} {",
@@ -156,12 +156,12 @@
" SocketServerProc ;# process the command in R",
"}\n}"),
collapse = "\n")
- # if {[gets $sock line] < 0} {return} # To handle incomplete lines!
+ ## if {[gets $sock line] < 0} {return} # To handle incomplete lines!
.Tcl(cmd)
- # Create the Tcl function that accepts input from a client
- # (a different one for each server port)
- # Code is slightly different if the server is only local or not
+ ## Create the Tcl function that accepts input from a client
+ ## (a different one for each server port)
+ ## Code is slightly different if the server is only local or not
if (isTRUE(local)) {
cmd <- paste(c(paste("proc sockAccept_", port, " {sock addr port} {",
sep = ""),
@@ -191,27 +191,27 @@
}
.Tcl(cmd)
- # Create the socket server itself in Tcl (a different one for each port)
- # If we want a secure server, use the tls secured socket instead
+ ## Create the socket server itself in Tcl (a different one for each port)
+ ## If we want a secure server, use the tls secured socket instead
if (isTRUE(secure)) {
.Tcl(paste("set Rserver_", port, "(main) [tls::socket -server sockAccept_",
#port, " -require 1 -cafile caPublic.pem -certfile ~/serverR.pem ",
port, " -certfile Rserver.pem -keyfile Rserver.pem -ssl2 1 -ssl3 1 -tls1 0 -require 0 -request 0 ",
port, "]", sep =""))
- # For client, use:
- # set chan [tls::socket -cafile caPublic.pem -certfile ~/clientR.pem server.site.net $port]
- # To generate the keys:
- # cd ~
- # Copy /System/Library/OpenSSL/openssl.cnf on ~, and edit
- # openssl genrsa -out serverR.pem 1024 # use -des3 to secure with a password
- # openssl req -new -x509 -key serverR.pem -out clientR.pem -days 365 -config openssl.cnf
- # ... and answer to a couple of questions
+ ## For client, use:
+ ## set chan [tls::socket -cafile caPublic.pem -certfile ~/clientR.pem server.site.net $port]
+ ## To generate the keys:
+ ## cd ~
+ ## Copy /System/Library/OpenSSL/openssl.cnf on ~, and edit
+ ## openssl genrsa -out serverR.pem 1024 # use -des3 to secure with a password
+ ## openssl req -new -x509 -key serverR.pem -out clientR.pem -days 365 -config openssl.cnf
+ ## ... and answer to a couple of questions
} else {
.Tcl(paste("set Rserver_", port, "(main) [socket -server sockAccept_",
port, " ", port, "]", sep =""))
}
- # Add this port in the TempEnv variable 'SocketServers'
+ ## Add this port in the TempEnv variable 'SocketServers'
socks <- getSocketServers()
namesocks <- names(socks)
if (!(portnum %in% socks)) {
@@ -220,5 +220,5 @@
socks <- sort(socks)
assign("SocketServers", socks, envir = TempEnv())
}
- return(TRUE) # Humm! Only if it succeeds...
+ return(TRUE) # Humm! Only if it succeeds...
}
Modified: pkg/svSocket/R/stopSocketServer.R
===================================================================
--- pkg/svSocket/R/stopSocketServer.R 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/R/stopSocketServer.R 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,6 +1,6 @@
stopSocketServer <- function (port = 8888)
{
- # Stop one or more running socket server(s)
+ ## Stop one or more running socket server(s)
if (port == "all") {
port <- getSocketServers()
servers <- port
@@ -11,14 +11,14 @@
anyclosed <- FALSE
for (i in 1:length(port)) {
Port <- port[i]
- if (Port %in% servers) { # This port is open
+ if (Port %in% servers) { # This port is open
anyclosed <- TRUE
- # First ask to all clients to nicely disconnect (note: if they don't
- # the server simply does not process them any more!)
+ ## First ask to all clients to nicely disconnect (note: if they don't
+ ## the server simply does not process them any more!)
closeSocketClients(serverport = Port)
- # Assign it back, with the corresponding port stripped out
- # But if I was the last one, delete the SocketServers variable
+ ## Assign it back, with the corresponding port stripped out
+ ## But if I was the last one, delete the SocketServers variable
servers <- servers[servers != Port]
if (length(servers) == 0) {
if (exists("SocketServers", envir = TempEnv(),
@@ -28,16 +28,16 @@
envir = TempEnv())
}
- # Eliminate the processing function from TempEnv
+ ## Eliminate the processing function from TempEnv
sockProc <- paste("SocketServerProc", Port, sep = "_")
if (exists(sockProc, envir = TempEnv()))
rm(list = sockProc, envir = TempEnv())
- # Close the socket in order not to reject future client connections
+ ## Close the socket in order not to reject future client connections
.Tcl(paste("close $Rserver_", Port, "(main)", sep = ""))
- # Note: Tcl procs and variables are not eliminated yet
- # because there may be still clients connected!
+ ## Note: Tcl procs and variables are not eliminated yet
+ ## because there may be still clients connected!
}
}
return(anyclosed)
Modified: pkg/svSocket/R/svSocket-Internal.R
===================================================================
--- pkg/svSocket/R/svSocket-Internal.R 2010-09-10 15:03:50 UTC (rev 301)
+++ pkg/svSocket/R/svSocket-Internal.R 2010-09-11 06:59:30 UTC (rev 302)
@@ -1,6 +1,6 @@
.onLoad <- function (lib, pkg)
{
- # Create our SciViews task callback manager
+ ## Create our SciViews task callback manager
assignTemp(".svTaskCallbackManager", svTaskCallbackManager())
}
@@ -12,13 +12,13 @@
.Last.lib <- function (libpath)
{
- # Make sure that all clients are disconnected
- # and all servers are closed
+ ## Make sure that all clients are disconnected
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 302
More information about the Sciviews-commits
mailing list