[Sciviews-commits] r175 - in pkg/svSocket: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 11 00:59:17 CEST 2009
Author: phgrosjean
Date: 2009-08-11 00:59:17 +0200 (Tue, 11 Aug 2009)
New Revision: 175
Removed:
pkg/svSocket/R/getServerObj.R
Modified:
pkg/svSocket/DESCRIPTION
pkg/svSocket/NAMESPACE
pkg/svSocket/NEWS
pkg/svSocket/R/evalServer.R
pkg/svSocket/R/startSocketServer.R
pkg/svSocket/man/closeSocketClients.Rd
pkg/svSocket/man/evalServer.Rd
pkg/svSocket/man/sendSocketServer.Rd
pkg/svSocket/man/startSocketServer.Rd
Log:
Clean up of evalServer()
Modified: pkg/svSocket/DESCRIPTION
===================================================================
--- pkg/svSocket/DESCRIPTION 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/DESCRIPTION 2009-08-10 22:59:17 UTC (rev 175)
@@ -2,11 +2,11 @@
Type: Package
Title: SciViews GUI API - R Socket Server
Depends: R (>= 2.6.0)
-Imports: tcltk
+Imports: tcltk, svMisc
Description: Implements a simple socket server allowing to connect GUI clients to R
-Version: 0.9-45
-Date: 2009-07-15
-Author: Philippe Grosjean
+Version: 0.9-46
+Date: 2009-08-10
+Author: Philippe Grosjean, Matthew Dowle
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL (>= 2)
LazyLoad: yes
Modified: pkg/svSocket/NAMESPACE
===================================================================
--- pkg/svSocket/NAMESPACE 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/NAMESPACE 2009-08-10 22:59:17 UTC (rev 175)
@@ -1,4 +1,4 @@
-import(tcltk)
+import(tcltk, svMisc)
export(evalServer,
getSocketClients,
Modified: pkg/svSocket/NEWS
===================================================================
--- pkg/svSocket/NEWS 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/NEWS 2009-08-10 22:59:17 UTC (rev 175)
@@ -1,5 +1,10 @@
= svSocket News
+== Changes in svSocket 0.9-46
+
+* evalServer() slightly reworked
+
+
== Changes in svSocket 0.9-45
* Bug correction in evalServer()
Modified: pkg/svSocket/R/evalServer.R
===================================================================
--- pkg/svSocket/R/evalServer.R 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/R/evalServer.R 2009-08-10 22:59:17 UTC (rev 175)
@@ -1,51 +1,74 @@
-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.
- 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.
- 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="")
- # its 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("..Last.value",file=.f) # 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)
- flush(.f)
- seek(.f,0)
- cat(readLines(.f),';',x,'=..Last.value;rm(..Last.value);cat("\\n<<<endflag>>>\\n");flush.console()\n',file=con,sep="")
- }
- objdump=""
- endloc=NULL
- while(!length(endloc)) {
- obj=readLines(con,n=1000,warn=FALSE)
- if (!length(obj)) {Sys.sleep(0.01);next} # wait for data to come back. Without this sleep, you get 20-30 calls to readLines before data arrives.
- endloc=grep("<<<endflag>>>",obj)
- if (length(endloc)) obj=obj[0:(endloc-1)]
- objdump<-c(objdump,obj) # this is more robust than paste'ing together a potentially very large single string.
- }
- if (!missing(send)) {
- if (!all(objdump=="")) stop(objdump)
- return(TRUE)
- }
- start = grep("<<<startflag>>>",objdump)
- if (length(start)!=1) stop("Unable to find <<<startflag>>>")
- objdump = objdump[-(1:start)] # the startflag is because sometimes (strangely rarely) seek, flush and dump can write return value to stdout which do not source.
- # 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
- objdump[i] = paste(objdump[i],objdump[i+1],sep="")
- objdump[i+1] = ""
- }
- objcon = textConnection(objdump)
- on.exit(close(objcon))
- source(objcon,local=TRUE,echo=FALSE,verbose=FALSE)
- ..Last.value
+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.
+ 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.
+ 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.
+ } 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("..Last.value", file <- .f)
+ flush(.f)
+ seek(.f, 0)
+ cat(readLines(.f), ';', x, ' <- ..Last.value; rm(..Last.value); cat("\\n<<<endflag>>>\\n"); flush.console()\n',
+ file = con, sep = "")
+ }
+ objdump <- ""
+ 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.
+ 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.
+ objdump <- c(objdump, obj)
+ }
+ if (!missing(send)) {
+ if (!all(objdump == "")) stop(objdump)
+ return(TRUE)
+ }
+ 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.
+ 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.
+ nospace <- grep("[^ ]$", objdump)
+ nospace <- nospace[nospace < length(objdump)]
+ for (i in rev(nospace)) { #robust to consecutive lines to be joined
+ objdump[i] <- paste(objdump[i], objdump[i + 1], sep = "")
+ objdump[i + 1] <- ""
+ }
+ objcon <- textConnection(objdump)
+ on.exit(close(objcon))
+ source(objcon, local = TRUE, echo = FALSE, verbose = FALSE)
+ return(..Last.value)
}
Deleted: pkg/svSocket/R/getServerObj.R
===================================================================
--- pkg/svSocket/R/getServerObj.R 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/R/getServerObj.R 2009-08-10 22:59:17 UTC (rev 175)
@@ -1,63 +0,0 @@
-getServerObj <-
-function (x, local = TRUE, server.envir = .GlobalEnv, con = NULL,
-host = "localhost", port = 8888, ...)
-{
- # Copy an R object from the server to the client
- objname <- as.character(substitute(x))
- servenv <- deparse(substitute(server.envir))
- if (is.null(con)) {
- # Use sendSocketServer() to open a connection to the serve, request the
- # object, and close the connection
- objdump <- sendSocketServer(paste('suppressWarnings(dump("', objname,
- '", file = "", envir = ', servenv,
- '))', sep = ""), host = host, port = port, ...)
- } else {
- # otherwise, use con to exchange data with the server, with a flag
- # to indicate where the returned dumped version of the R object ends
- writeLines(paste('suppressWarnings(dump("', objname,
- '", file = "", envir = ', servenv,
- ')); cat("<<<endflag>>>")', sep = ""), con)
- objdump <- ""
- while (regexpr("<<<endflag>>>", objdump) < 0)
- objdump <- paste(objdump, readLines(con), sep = "", collapse = "\n")
- objdump <- sub("<<<endflag>>>", "", objdump)
- }
- # Source the content of objdump, locally, or in .GlobalEnv on the client R
- objcon <- textConnection(objdump)
- on.exit(close(objcon))
- res <- eval(source(objcon, local = local, echo = FALSE,
- verbose = FALSE), envir = envir)
-}
-
-setServerObj <-
-function (x, envir = .GlobalEnv, con = NULL,
-host = "localhost", port = 8888, ...)
-{
- # Copy an R object from the client to the server
- objname <- as.character(substitute(x))
- # Get a dump of the local object
- objdump <- suppressWarnings(dump(objname, file = "", envir = envir))
-
- servenv <- deparse(substitute(server.envir))
- if (is.null(con)) {
- # Use sendSocketServer() to open a connection to the serve, request the
- # object, and close the connection
- objdump <- sendSocketServer(paste('suppressWarnings(dump("', objname,
- '", file = "", envir = ', servenv,
- '))', sep = ""), host = host, port = port, ...)
- } else {
- # otherwise, use con to exchange data with the server, with a flag
- # to indicate where the returned dumped version of the R object ends
- writeLines(paste('suppressWarnings(dump("', objname,
- '", file = "", envir = ', servenv,
- ')); cat("<<<endflag>>>")', sep = ""), con)
- objdump <- ""
- while (regexpr("<<<endflag>>>", objdump) < 0)
- objdump <- paste(objdump, readLines(con), sep = "", collapse = "\n")
- objdump <- sub("<<<endflag>>>", "", objdump)
- }
- # Source the content of objdump, locally, or in .GlobalEnv on the client R
- objcon <- textConnection(objdump)
- on.exit(close(objcon))
- source(objcon, local = FALSE, echo = FALSE, verbose = FALSE)
-}
\ No newline at end of file
Modified: pkg/svSocket/R/startSocketServer.R
===================================================================
--- pkg/svSocket/R/startSocketServer.R 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/R/startSocketServer.R 2009-08-10 22:59:17 UTC (rev 175)
@@ -45,7 +45,7 @@
# Create the callback when a client sends data
"SocketServerProc" <- function ()
{
- require(tcltk)
+ #require(tcltk)
# Note: I don't know how to pass arguments here.
# So, I use Tcl global variables instead:
# - the server port from $::sockPort,
Modified: pkg/svSocket/man/closeSocketClients.Rd
===================================================================
--- pkg/svSocket/man/closeSocketClients.Rd 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/man/closeSocketClients.Rd 2009-08-10 22:59:17 UTC (rev 175)
@@ -8,7 +8,7 @@
further process on their side). This function is used by \code{\link{stopSocketServer}},
but it can also be invoked manually to ask for disconnection of a particular client.
Note that, in this case, the client still can decide not to disconnect! The code
- send to ask for client disconnection is: \code{\b}.
+ send to ask for client disconnection is: \code{\\f}.
}
\usage{
Modified: pkg/svSocket/man/evalServer.Rd
===================================================================
--- pkg/svSocket/man/evalServer.Rd 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/man/evalServer.Rd 2009-08-10 22:59:17 UTC (rev 175)
@@ -1,7 +1,7 @@
\name{evalServer}
\alias{evalServer}
-\title{ Evaluate R code in a server process. }
+\title{ Evaluate R code in a server process }
\description{
This function is designed to connect two R processes together using
the socket server. This function allows for piloting the server R process from
@@ -66,8 +66,8 @@
evalServer(con, X)
evalServer(con, "Z <- X + 3") # send an assignment to execute remotely
evalServer(con, X + Z)
-evalServer(con,"Z <- X + 1:1000; NULL") # same but prevents Y being returned
-evalServer(con,length(Z))
+evalServer(con, "Z <- X + 1:1000; NULL") # same but prevents Y being returned
+evalServer(con, length(Z))
Z <- evalServer(con, Z) # bring it back to client
Z
Modified: pkg/svSocket/man/sendSocketServer.Rd
===================================================================
--- pkg/svSocket/man/sendSocketServer.Rd 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/man/sendSocketServer.Rd 2009-08-10 22:59:17 UTC (rev 175)
@@ -7,11 +7,11 @@
The text is send to one R socket server and evaluated there as a command in
\code{.GlobalEnv}. Results (text as it should be printed on the console) is
returned to the client and the client then disconnects automatically (code
- received for indicating to disconnect is \f... don't use it for other purposes)!
+ received for indicating to disconnect is \\f... don't use it for other purposes)!
}
\usage{
-sendSocketServer(text, host = "localhost", port = 8888)
+sendSocketServer(text, host = "localhost", port = 8888, ...)
}
\arguments{
@@ -19,12 +19,14 @@
\item{host}{ The name or address of the host where the R socket server
is located. }
\item{port}{ The port of the R socket server. }
+ \item{\dots}{ Further arguments passed to communicate with the server
+ (not used yet) }
}
\author{Philippe Grosjean (\email{phgrosjean at sciviews.org})}
-\seealso{ \code{\link{sendSocketClients}}, \code{\link{closeSocketClients}},
- \code{\link{processSocket}} }
+\seealso{ \code{\link{evalServer}}, \code{\link{sendSocketClients}},
+ \code{\link{closeSocketClients}}, \code{\link{processSocket}} }
\examples{
\dontrun{
@@ -41,6 +43,8 @@
# Nothing happens, but switch to R #1 and type
# x
# to see the result
+
+# For a more elaborate version, use evalServer()
}
}
Modified: pkg/svSocket/man/startSocketServer.Rd
===================================================================
--- pkg/svSocket/man/startSocketServer.Rd 2009-08-10 22:00:31 UTC (rev 174)
+++ pkg/svSocket/man/startSocketServer.Rd 2009-08-10 22:59:17 UTC (rev 175)
@@ -14,7 +14,8 @@
}
\usage{
-startSocketServer(port = 8888, server.name = "Rserver", procfun = processSocket)
+startSocketServer(port = 8888, server.name = "Rserver", procfun = processSocket,
+secure = FALSE, local = !secure)
stopSocketServer(port = 8888)
}
@@ -23,6 +24,10 @@
\item{server.name}{ The internal name of this server }
\item{procfun}{ The function to use to process client's commands. By default,
it is \code{processSocket()}. }
+ \item{secure}{ Do we start a secure (TLS) server? (not implemented yet) }
+ \item{local}{ If \code{TRUE}, accept only connections from local clients, i.e.,
+ from clients with IP address 127.0.0.1. Set by default if the server is not
+ secure. }
}
\details{
@@ -37,7 +42,7 @@
\note{ This server is currently synchronous in the processing of the command.
However, neither R, nor the client are blocked during exchange of data
(communication is asynchronous).
-
+
Note also that socket numbers are reused, and corresponding configurations
are not deleted from one connection to the other. So, it is possible for
a client to connect/disconnect several times and continue to work with the
More information about the Sciviews-commits
mailing list