Nothing
#-------------------------------------------------------------------------#
# opentick R package, copyright (C) Joshua M. Ulrich, 2007-2008 #
# Distributed under GNU GPL version 3 #
#-------------------------------------------------------------------------#
'otConnect' <-
function(host='delayed1.opentick.com', port=10015, ...) {
# Make sure host/port args agree
host <- match.arg(host, c('feed1.opentick.com','feed2.opentick.com',
'delayed1.opentick.com','delayed2.opentick.com'), several.ok=FALSE)
if( !(regexpr('^[fF]',host) > 0 && port == 10010) &&
!(regexpr('^[dD]',host) > 0 && port == 10015) )
stop('\'host\' and \'port\' do not align')
if(NROW(host)!=NROW(port)) {
stop('\'host\' and \'port\' must have same length')
}
# Create connection parameters
otPar <- getParams()
otPar$host <- host
otPar$port <- port
otPar$platform <- OT$PLATFORM_OT
otPar$platformPassword <- ''
# Get environment
env <- as.environment("package:opentick")
# Check if binding locked; unlock if needed
locked <- bindingIsLocked('.otConnection', env)
if(locked) {
unlockBinding('.otConnection', env)
}
for(i in 1:NROW(host)) {
if(inherits(try(
assign('.otConnection',socketConnection(host[i], port[i], open='r+b', blocking=TRUE),env),
silent=TRUE),'try-error')) {
next
} else {
otPar$host <- host[i]
otPar$port <- port[i]
break
}
}
setParams(otPar)
# Re-lock, if needed
if(locked) {
suppressWarnings({
lockBinding('.otConnection', env)
})
}
return(invisible(1))
}
'otLogin' <-
function(username=NULL, password=NULL) {
# Prompt for username and password
if(is.null(username)) username <- readLines(n=1)
if(is.null(password)) password <- readLines(n=1)
# Connectoin parameters
otPar <- getParams()
# Construct Message Body
msgBody <-
pack("v C C a16 a6 a64 a64",
OT$PROTOCOL_VER, # 2 : OT Protocol Version
getOS(), # 1 : Operating System ID
otPar$platform, # 1 : Platform ID
otPar$platformPassword, # 16 : Platform ID password
'', # 6 : MAC address
username, # 64 : Username
password) # 64 : Password
# Transmit to OT Server
reqID <- getRequestID()
sendRequest(OT$LOGIN, reqID, msgBody)
# Server response
response <- getResponse(nullError=TRUE)
# Parse Response Body
resBody <- unpack('A64 C A64 v', response$body)
names(resBody) <- c('sessionID','redirect','redirectHost','redirectPort')
# Update connection parameters
otPar$redirect <- as.logical(resBody$redirect)
otPar$redirectHost <- resBody$redirectHost
otPar$redirectPort <- resBody$redirectPort
otPar$username <- username
otPar$password <- password
otPar$loggedIn <- TRUE
otPar$sessionID <- resBody$sessionID
setParams(otPar)
# Redirect?
if( otPar$redirect ) {
.otAddHost(otPar$redirectHost,otPar$redirectPort)
otLogin(username,password)
}
return(invisible(1))
}
'otLogout' <-
function() {
loggedIn()
# Connectoin parameters
otPar <- getParams()
# Construct Message Body
msgBody <-
pack('a64', otPar$sessionID)
# Transmit to OT Server
reqID <- getRequestID()
sendRequest(OT$LOGOUT, reqID, msgBody)
# Server response
response <- getResponse()
# Add sessionID and loggedIn values to connection parameters
otPar$loggedIn <- FALSE
otPar$sessionID <- ''
setParams()
.otDisconnect()
return(invisible(1))
}
'.otReconnect' <-
function() {
open <- connected(stop=FALSE)
# Reconnect, if connection is not open
if(!open) {
# Create connection parameters
otPar <- getParams()
# Make sure old connection is closed
.otDisconnect()
# Make a new connection
otConnect()
# Login to new connection
otLogin(otPar$username,otPar$password)
} else {
return(invisible())
}
}
'.otDisconnect' <-
function() {
x <- try(close(getSocket()), silent=TRUE)
}
'.otAddHost' <-
function(host, port) {
if( !(regexpr('^[fF]',host) > 0 && port == 10010) &&
!(regexpr('^[dD]',host) > 0 && port == 10015) )
stop('\'host\' and \'port\' do not align')
x <- getParams()
x$host <- c(host,x$host)
x$port <- c(port,x$port)
setParams(x)
}
# Actual Socket Connection
'.otConnection' <- list()
# Socket Connection Parameters
'.otParams' <- list(
host=NULL,
port=NULL,
redirect=FALSE,
redirectHost=NULL,
redirectPort=NULL,
username='',
password='',
loggedIn=FALSE,
sessionID='',
requestID=0,
platform=NULL,
platformPassword=NULL)
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.