# Helper function, not exported
portfree <- function(p) {!any(grepl(paste0('[^0-9]',p,' .*LISTEN'), system('netstat -an', intern = TRUE)))}
.onAttach <- function(libname, pkgname) {
packageStartupMessage('Based on the mongolite-package by Jeroen Ooms')
}
#' MongoDB client with extra functionality
#'
#' Comparable to mongolite::mongo, but with a few extra methods (taggedfind, adjust), an extra RMongo-object,
#' and handles to the collection object and client object exposed, so you can write your own extensions
#'
#' @param collection name of collection
#' @param db name of database
#' @param url address of the mongodb server in mongo connection string \href{http://docs.mongodb.org/manual/reference/connection-string}{URI format}
#' @param host,port alternatively, you can provide a host and port, which is then resolved to "mongodb://\emph{host}[:\emph{port}]
#' Ignored if url is given. Defaults to localhost:27017
#' @param verbose emit some more output
#' @param options additional connection options such as SSL keys/certs. See mongolite documentation
#' @param extraSlots list of extra slots/methods to attach to the object. Useful to keep track of additional properties,
#' see for example how it is used with \code{\link{OpenDockerMongo}}, and to add even more methods. If a function is supplied, it's environment is changed to inside this object.
#' @return A pointer to a collection on the server. It can be interfaced using methods, or the client or col attributes.
#' @section Methods:
#' The same methods as \code{\link[mongolite]{mongo}} provides, along with the following:
#' \describe{
#' \item{\code{taggedfind(qry='{}', tagfields='_id', arrayfield, sort='{}', skip=0, limit=0, handler=NULL, pagesize=1000, cachesize=5e4, verbose=verbose, stringsAsFactors=default.stringsAsFactors())}}{Find values inside documents, with pointers to the root-document, see \code{\link{taggedMongofind}}. Verbose defaults to the value given at creation of monPlus, but can be adjusted.}
#' \item{\code{adjust(findqry='{}', infields=c('All'), setfield='extraInfo',unboxsubf=c(), FUN, FUNvectorized=FALSE, skip=0, limit=0,pagesize=1000, verbose=verbose)}}{Adjust values in DB with FUN, see \code{\link{mongoAdjust}}}
#' \item{\code{lives(tempname=NULL)}}{Test if connection is still alive, and documents can be inserted, retrieved and removed. For debugging, you can apply an ID-field for a temporary inserted document, if NULL a random string is generated.}
#' }
#' Beside these methods, you can:
#' \describe{
#' \item{}{Access the client and collection objects themselves. In mongolite::mongo() these were hidden attributes, here you can access them directly}\cr
#' \item{}{Get access to the used parameters: collection (in the return called collectionname to avoid confusion with the collection-object), db (called dbname), url, host, port, verbose and options}
#' \item{}{Get access to extra slots you've specified with extraSlots, to add more properties and methods.}
#' \item{}{Get an accompanying RMongo-object, as if you called RMongo::mongoDBConnect(), so you can use for example \code{dbShowCollections(monPlus('MyCol','MyDb')$Rmongo)}}
#' }
#' They are mostly useful if you want to dig deeper into the methods
#' @seealso \code{\link[mongolite]{mongo}}\cr
#' \code{\link[RMongo]{mongoDbConnect}}
#' @references \code{\link[mongolite]{mongo}}\cr
#' \href{https://jeroen.github.io/mongolite/}{Mongolite User Manual}\cr
#' Jeroen Ooms (2014). The \code{jsonlite} Package: A Practical and Consistent Mapping Between JSON Data and R Objects. \emph{arXiv:1403.2805}. \url{http://arxiv.org/abs/1403.2805}
#' @export
monPlus <- function(collection, db, url, host, port, verbose = FALSE, options = mongolite::ssl_options(), extraSlots=list()) {
if(missing(url)) {
if(missing(host)) host <- 'localhost'
if(missing(port)) port <- 27017
url <- paste0('mongodb://',host,':',port)
} else {
host <- gsub('(^.*://)|(:[0-9]+$)','',url)
port <- if(grepl(':[0-9]+$', url)) regmatches(url, regexpr(':[0-9]+$', url)+1) else 27017
}
client <- mongolite:::mongo_client_new(uri=url,options)
col <- mongolite:::mongo_collection_new(client,collection, db)
parent <- mongolite::mongo(collection, db, url, verbose, options)
mlite <- new.env(parent=parent)
mlite$client <- client
mlite$col <- col
mlite$RMongo <- RMongo::mongoDbConnect(db, host, port)
verbose2 <- verbose
mlite$taggedfind <- function(qry='{}', tagfields = "_id", arrayfield, sort = "{}", skip = 0, limit = 0, handler = NULL, pagesize = 1000, cachesize = 50000, verbose = verbose2, stringsAsFactors = default.stringsAsFactors()) {
taggedMongofind(moncol = col, qry = qry, tagfields = tagfields, arrayfield = arrayfield, sort = sort,
skip = skip, limit = limit, handler=handler, pagesize = pagesize,
cachesize = cachesize, verbose = verbose, stringsAsFactors = stringsAsFactors)
}
mlite$adjust <- function(findqry = "{}", infields = c("All"), setfield = "extraInfo_from_R",
FUN, ..., jsonargs = list(), skip = 0, limit = 0, pagesize = 1000,
verbose = verbose2) {
mongoAdjust(moncol=col, findqry = findqry, infields = infields, setfield = setfield, FUN=FUN, ...,
jsonargs = jsonargs, skip = skip, limit = limit, pagesize = pagesize, verbose = verbose)
}
mlite$lives <- function(tempname=NULL) {
if(missing(tempname)) tempname <- paste0(sample(c(LETTERS, 0:9),size = 20, replace=TRUE), collapse='')
if(length(tempname)!=1 || !is.character(tempname)) stop('lives-method should be called with length-one character')
return(tryCatch({
if(!'ID' %in% colnames(mlite$index()$key)) {
cat("Adding index for ID in db, this might take a while if it's already filled.\n")
mlite$index(add='{"ID":1}')
}
if(mlite$count()<0) stop()
if(mlite$count()>0 && mlite$count(paste0('{"ID":"',tempname,'"}'))>0) {
temp <- mlite$iterate(paste0('{"ID":"',tempname,'"}'))
ret <- temp$one()
} else {
if(mlite$insert(paste0('{"ID":"',tempname,'"}'))$nInserted!=1) stop()
temp <- mlite$iterate(paste0('{"ID":"',tempname,'"}'))
ret <- temp$one()
if(!mlite$remove(paste0('{"ID":"',tempname,'"}'))) stop()
}
if(!identical(ret, list(ID=tempname))) stop()
TRUE
},
error=function(e) {
return(FALSE)
}))
}
mlite$collectionname <- collection
mlite$dbname <- db
mlite$url <- url
mlite$host <- host
mlite$port <- port
mlite$options <- options
mlite$verbose <- verbose2
for(f in ls(parent)) assign(f, get(f, pos=parent), mlite)
if(length(extraSlots)) {
for(i in 1:length(extraSlots)) {
if(is.function(extraSlots[[i]])) environment(extraSlots[[i]]) <- mlite
assign(names(extraSlots)[i], extraSlots[[i]], mlite)
}
}
class(mlite) <- unique(c('monPlus',class(parent), class(mlite)))
return(mlite)
}
#' @export
print.monPlus <- function(x, ...) {
mongolite:::print.mongo(parent.env(x), ...)
extra <- ls(x)[!ls(x) %in% ls(parent.env(x))]
extracl <- sapply(extra, function(obj) {class(get(obj, x))})
extrafun <- extra[extracl=='function']
extraobj <- extra[extracl!='function']
cat('Extra methods monPlus-methods:',
paste0(' ', c(sapply(extrafun, function(obj) {
argsline <- deparse(args(get(obj, x)))
argsline <- argsline[-length(argsline)]
gsub('function ', obj, argsline)
}))),
'Extra accessors to attributes:',
paste0(' ',extraobj, ' (', sapply(extraobj, function(obj) {class(get(obj, pos=x))}),'-object)'),
sep='\n')
}
#' Start mongo-instance in docker
#'
#' If you want to run your own mongoDB instance, this can be done as a docker container. This function initializes an instance for you from R.
#' In a typical setup, it follows these steps:
#' \enumerate{
#' \item Check if docker is running, if not, start it
#' \item If update is set to TRUE, and a container with the given dockername exists, it is stopped and removed.
#' \cr Likewise for a viewer-container, and then images are downloaded and installed.
#' \item Check if a container with the given dockername exists. If not, create one:
#' \itemize{
#' \item The script first check if the given port is still free (no process is \emph{currently} listening). If yes, it uses this port.
#' \cr If not, but the port is in use by another docker-container and kickport is set to TRUE, stop that docker-container
#' \cr Or if port is given as a textstring ending with '+', increase portnumber until a free port is found
#' \cr Otherwise, an error is thrown.
#' \item if update is set to TRUE, the script checks whether a new version of the image is available, and updates that.
#' \item Finally the docker container is started.
#' \item If a username is given, it is initialized with the --auth option, meaning authentication is required in subsequent access as well.
#' \item If no image-name is provided, "mongo" is used.
#' \item Data (files in docker-fs /data/db) is stored in \emph{path}. A logfile is located here as well (called log.log)
#' }
#' \item If a container with the given dockername exists, but is not running, restart it.
#' \cr In this case, the port number/imagename/path of this container is used, if needed with a warning.
#' \item See if the docker-container is responding: if we can establish a connection, and insert and remove documents.
#' \cr If you want to debug: it inserts and removes a document with the following content: '{ID: "ConnectionTesting_r78qfuy8asfhaksfhajklsfhajksl"}'
#' \item if inclView is not NULL, a GUI is also initialized, as a docker container
#' \itemize{
#' \item Also updated if update is TRUE
#' \item Uses port given in viewport, increased if necessary and port ends with "+"
#' \item The docker container for the viewer is called \emph{dockername}_view. The mongo-express container can only be coupled to a mongo instance running in docker,
#' so currently it is not possible to set up a mongo-viewer for a remote server.
#' \item If there is already a container with that name, it is restarted (note that this cannot be the case if update was TRUE, then any viewer-container is already removed).
#' \cr If this container is pointing to another mongo-instance, a warning is generated.
#' }
#' \cr That GUI can be found with any internet browser, going to http://localhost:\emph{viewport}
#' }
#' You can skip any of these steps with the skip parameter, e.g. if you already know you want to connect to a certain port,
#' but don't know what the docker container is called (or there is no docker container, and you want to connect to a remote server).
#' \cr\cr Furthermore, the starting process of docker and the docker container may take some time. This can be done in the background, by setting preOnly to TRUE.
#' If the script then encounters a situation in which it has to wait, it returns a numerical, indicating the step to resume. Thus, you can run your own script by first calling
#' OpenDockerMongo(preOnly=TRUE, ...), then soing some useful work (that may take time), then calling OpenDockerMongo again (when it will hopefully be ready for the next step)
#'
#' @param dockername name of docker container that is runnning the mongo-server. May be NULL if skip >1, in which case it connects to the host and port given.
#' @param imagename name of docker image to use. If dockername is given, a container already exists and update is FALSE, this is ignored (if needed with a warning, supply NULL to also suppress warnings)
#' @param path path to store data (docker file-system: /data/db). If dockername is given, a container already exists and update is FALSE, this is ignored (if needed with a warning, this may cause false positives if symbolic links are used, or a path needs to be further expanded)
#' /cr If path does not exist, it is created, and a new database is initialized.
#' @param host use to connect to a remote server. If it is not null, '', localhost or similar, skip is set to 4, any docker parameters are ignored (with a warning if needed)
#' @param port port to use, default mongoport is 27017. Appending with "+" means a higher port number may be used if needed. Ignored if a container is just restarted (with a warning if the port number was exact, or the difference between number provided and used is more than 10. Use port 0 to suppress any warnings)
#' @param kickport If port is already in use by another docker container, should this container be stopped? Ignored if port ends in "+". Only looks at running containers, and stops them, but doesn't remove them.
#' @param inclView also initialize an extra container that links to the mongo-server, for example to be used as a GUI. The default, mongo-express, gives a webinterface to the mongo-DB.
#' \cr Given as a string with the docker imagename, 'previous', or NULL to not start anything. The value 'previous' only works if there already is a viewer-container initialized, which you just want to restart without any checks.
#' \cr Currently only tested with NULL or mongo-express, unlikely to work for other vallues (but may be expanded in the future).
#' @param viewport Port to use for the viewer-container, can also be appended with "+", ignored if inclView==FALSE. Ignored if a container is just restarted (with a warning if the port number was exact, or the difference between number provided and used is more than 10. Use port 0 to suppress any warnings)
#' @param update logical, should the script restart everything? If TRUE does the following:\itemize{
#' \item stop containers with \emph{dockername} or \emph{dockername_view}
#' \item remove containers with \emph{dockername} or \emph{dockername_view}
#' \item Update the docker images (imagename and inclView if not NULL)
#' }
#' @param preOnly logical, if the script has to wait for a docker action, should it return control? If TRUE and it has to wait, it returns a numerical that can be given to skip for the next call.
#' Does not work for downloading new images (cannot be run as background task)
#' \cr Note that if the return is >2, any old containers are already removed and updated, so setting update to TRUE would waste extra time.
#' @param skip steps to skip, e.g. if you already have a server instance initialized, you can use skip=4. Numbering is identical to the steps enumerated here, the script starts with skip+1.
#' @param db,collection,user,pswd Parameters used for connecting to the server: databasename, collection-name, username and password. If user is NULL,
#' authentication is disabled when creating the container.
#' @param verbose print output indicating status?
#'
#' @return An monPlus-object, or if preOnly is TRUE and we have to wait for a background process, a numerical indicating what step we are (which can be given to skip).
#' @examples
#' # From a fresh install.
#' # Using preOnly means that while docker is starting, control is returned.
#' DB <- OpenDockerMongo('MyMongoContainer', path='~/Docker/Mongo/MyDb',
#' preOnly=TRUE, db='MyDb',collection='MyCol')
#' # Generate new documents to insert, while generating these docs,
#' # docker processes are running in the background:
#' Docs <- data.frame(MyID=1:100, myData=rnorm(100))
#' if(is.numeric(DB)) DB <- OpenDockerMongo('MyMongoContainer', path='~/Docker/Mongo/MyDb',
#' db='MyDb',collection='MyCol', skip=DB)
#' # Control is only returned when finished, so DB is now a monPlus-object.
#' DB$insert(Docs)
#' # If port 8081 was previously free, you can now browse your docs at http://localhost:8081
#'
#' # Cleaning up:
#' DB$remove(paste0('{"MyID": {"$in": [',paste0(1:100, collapse=', '),']}}'))
#' if(DB$count()==0) DB$drop()
#' system('docker stop MyMongoContainer')
#' system('docker stop MyMongoContainer_view')
#' system('docker rm MyMongoContainer')
#' system('docker rm MyMongoContainer_view')
#'
#' @seealso \url{http://www.docker.com} for general information on docker
#' \cr \url{https://hub.docker.com/_/mongo/} for information on running a mongo-container in docker
#' \cr \pkg{mongolite}
#' \cr \pkg{RMongo}
#' @export
OpenDockerMongo <- function(dockername, imagename='mongo', path,
host='localhost', port='27017+', kickport=FALSE,
inclView='mongo-express', viewport='8081+', update=FALSE, preOnly=FALSE, skip=0,
db, collection, user=NULL, pswd=NULL, verbose=TRUE) {
suppliedport <- port;suppliedviewport <- viewport
if(!is.numeric(port)) {
if(!grepl('\\+$', port)) stop('Bad arguments: Unclear port')
port <- suppressWarnings(as.numeric(gsub('\\+$','',port)))
if(is.null(port) || is.na(port) || !is.numeric(port) || port==0) stop('Unclear port')
plusport <- TRUE
} else plusport <- FALSE
if(!is.numeric(viewport)) {
if(!grepl('\\+$', viewport)) stop('Bad arguments: Unclear viewport')
viewport <- suppressWarnings(as.numeric(gsub('\\+$','',viewport)))
if(is.null(viewport) || is.na(viewport) || !is.numeric(viewport) || viewport==0) stop('Unclear viewport')
plusviewport <- TRUE
} else plusviewport <- FALSE
if(!missing(path)) path <- sub('/$','',path.expand(path))
if(!Sys.info()['sysname'] %in% c('Darwin'))
warning('This function has only been tested on OSX, system calls may not function on your system.')
if(missing(host) || is.null(host) || host %in% c('','127.0.0.1','::1')) host <- 'localhost'
if(skip<4 && host!='localhost') {
if(!missing(dockername) && !is.null(dockername) ||
!missing(imagename) && !is.null(imagename) && imagename!='mongo' ||
!missing(path) && !is.null(path) ||
!is.numeric(port) ||
!missing(inclView) && !is.null(inclView) && inclView!='mongo-express' ||
!missing(viewport) && !is.null(viewport) && viewport!='8081+')
warning('You have provided a remote host (',host,'), but parameters which suggest running a docker-container, which is incomaptible.\n',
'Ignoring parameters, trying to just set up connection instead')
skip <- 4
inclView <- NULL
}
if(skip<1) { # Check if docker is running
if(!any(grepl('Docker.app', system('/bin/ps aux', intern=TRUE)))) {
if(verbose) cat('Starting docker')
if((retcode <- system('open --background -a Docker'))!=0) stop('Unxpected return value when starting docker:\n',retcode)
if(preOnly) {
if(verbose) cat('\n')
cat('Opening docker in background, meanwhile returning control to caller.\n')
return(0)
}
}
# Tries: a counter that keeps track of how often we've already tried to connect to docker.
# Special value: 1e6=no success, but preOnly, so we have to return. 2e6+n: Success after n attempts
tries <- 0
while(tries<500) {
tryCatch({
if(substring(suppressWarnings(system2('docker', args=c('ps'), stderr=TRUE, stdout=TRUE)[1]),
1,12)!='CONTAINER ID') stop('ToCatchError')
tries <- tries+2e6
}, error=function(e) {
if(preOnly) {
tries <- 1e6
} else {
cat('.')
tries <<- tries+1
Sys.sleep(tries<500)
}
})
}
if(tries==1e6) {
if(verbose) cat('\n')
return(0)
}
if(tries==500) {
stop('\nDocker seems not to get ready')
} else if(verbose && tries>2e6) {
cat('\nDocker started succesfully.')
} else if(verbose) {
cat('Docker is running and responding.')
}
if(verbose || (tries>0 && tries<500)) cat('\n')
} # Check if docker is running
if(skip>1 && update) {
warning('OpenDockerMongo: Restarting docker containers (argument update set to TRUE) means going back to step 2, which is incompatible with skip=',skip,
'.\nIgnoring this skip value.')
skip <- 1
}
if(skip<2 && update) { # Remove any existing/running containers
for(name in c(paste0(dockername, '_view'), dockername)) {
if(any(grepl(paste0(' ',gsub('.','\\.',name, fixed=TRUE),'$'),system('docker ps', intern=TRUE)))) {
if(verbose) cat('Stopping container "',name,'"\n', sep='')
if(system(paste('docker stop', name), intern=TRUE)!=name)
stop('Unexpected retun value from docker engine when attempting to stop ', name)
}
if(any(grepl(paste0(' ',gsub('.','\\.',name, fixed=TRUE),'$'),system('docker ps -a', intern=TRUE)))) {
if(verbose) cat('Removing container "',name,'"\n', sep='')
if(system(paste('docker rm', name), intern=TRUE)!=name)
stop('Unexpected retun value from docker engine when attempting to stop ', name)
}
}
} # Remove any existing/running containers
if(skip<3) { # Check if container exists, if not, create one
if(missing(dockername)) stop('No dockername supplied, but this is needed unless skip>=3')
if(!any(grepl(paste0(' ',gsub('.','\\.',dockername, fixed=TRUE),'$'),system('docker ps -a', intern=TRUE)))) {
# Do we need to update the image/get a new image?
if(update || !any(grepl(paste0('^',gsub(':',' +',imagename),' '), system('docker image ls', intern=TRUE)))) {
if(verbose) cat('Pulling image, this might take a while.\n')
retval <- system(paste('docker pull', imagename), intern = TRUE)
if(!is.null(attr(retval,'status')) ||
!grepl(paste0('(Status: Image is up to date for ',imagename,')|(Status: Downloaded newer image for ',imagename,')'),
retval[length(retval)]))
stop('Error in pulling new image. Output:\n',
paste(retval, sep = '\n'),'\n')
if(verbose) cat(gsub('^Status: ','',retval[length(retval)]),'\n')
}
if(verbose) cat('Creating mongo-container "',dockername,'"\n', sep = '')
if(missing(path)) stop('When a new dockercontainer needs to be created, path must be supplied')
if(!plusport && !kickport && !portfree(port)) warning('It looks like port',port,'is already in use. Continuing, but this function will likely fail.')
while(plusport && !portfree(port+is.numeric(plusport)*plusport)) plusport <- is.numeric(plusport)*plusport+1
port <- port+is.numeric(plusport)*plusport
if(verbose && is.numeric(plusport)) cat('Using port',port,'for mongo-container\n')
if(kickport && !portfree(port)) { # If both plusport and kickport were TRUE, portfree(port) already gives TRUE at this point
retval <- system('docker ps', intern=TRUE)[-1]
tostop <- retval[grepl(paste0(':',port,'->27017/tcp'), retval)]
tostop <- substr(tostop, regexpr('[^ ]+$', tostop), nchar(tostop))
tostop <- tostop[!is.na(tostop) & !is.null(tostop) & tostop!='']
if(length(tostop)>1) stop('Error in trying to decide which container to stop')
if(length(tostop)==0) stop('Error in freeing port ',port, '. Is this port in use by a non-docker process?')
if(verbose) cat('Freeing port ',port,' by stopping docker-container with name ',tostop,'.\n',sep = '')
if(system(paste('docker stop',tostop), intern=TRUE)!=tostop) stop('Unexpected return value when trying to stop ',tostop)
}
retval <- suppressWarnings(system2(command='docker', args=paste0(
'run --name ',dockername,' -v ',path,':/data/db -p ',port,':27017 -d '
,imagename, ' --logpath /data/db/log.log',ifelse(is.null(user),'',' --auth')),
stdout = TRUE, stderr=TRUE))
if(!is.null(attr(retval,'status')) || length(retval)>1 || grepl('[^0-9a-fA-F]', retval))
stop('Starting docker-container seemed unsuccesful. Extra details:\n',
'Command run:\n',
paste0('docker run --name ',dockername,' -v ',path,':/data/db -p ',port,':27017 -d '
,imagename, ' --logpath /data/db/log.log',ifelse(is.null(user),'',' --auth'),'\n'),
'Return status-code: ',ifelse(is.null(attr(retval,'status')), '0 (success)',attr(retval,'status')),'\n',
'Return text:\n',
paste(retval, collapse='\n'),'\n'
)
if(verbose) cat('Docker-container "', dockername, '" created succesfully.\n', sep='')
}
} # Check if container exists, if not, create one
if(skip<4) { # If container exists but is not running, restart it. And do some checks
if(!any(grepl(paste0(' ',gsub('.','\\.',dockername, fixed=TRUE),'$'),system('docker ps', intern=TRUE)))) {
if(!any(grepl(paste0(' ',gsub('.','\\.',dockername, fixed=TRUE),'$'),system('docker ps -a', intern=TRUE))))
stop('No container found with name "',dockername,'", which is unexpected at this step')
retval <- system(paste('docker start', dockername), intern=TRUE)
if(!is.null(attr(retval,'status')) || length(retval)!=1 || retval!=dockername)
stop('Restarting container "', dockername, '" seemed unsuccesful. Details:\n',
'Command used: docker start ', dockername, '\n',
'Return code: ', ifelse(is.null(attr(retval, 'status')), '0 (success)', attr(retval, 'status')), '\n',
'Return text:\n',
paste(retval, collapse='\n'))
if(verbose) cat('Restarted container "',dockername,'"\n', sep='')
} else if(verbose) {
cat('Found running docker container.\n')
}
retval <- system(paste('docker inspect', dockername), intern=TRUE)
if(!is.null(attr(retval, 'status'))) stop('Inspecting of docker container "',dockername,'" failed.')
# Checks: imagename, path, port
if(!is.null(imagename) && !any(grepl(paste0('"Image": "',imagename,'"'), retval, fixed=TRUE)))
warning('Restarted docker-container "',dockername,'", but this container is not running image ',imagename)
contpath <- regexpr('"Source": "[^"]+",', gsub('\\','/',retval, fixed=TRUE))
contpath[contpath!=-1][!grepl('"Destination": "/data/db",',retval[which(contpath!=-1)+1])] <- -1
if(sum(contpath!=-1)!=1) stop('Error in trying to find this containers path.')
contpath <- substring(retval[contpath!=-1], contpath[contpath!=-1]+11,
contpath[contpath!=-1]+attr(contpath, 'match.length')[contpath!=-1]-3)
if(!missing(path) && contpath!=path)
warning('Restarted docker-container "',dockername,'", but this container is using path "',contpath,
'" instead of the path provided ("',path,'")')
path <- contpath
# Check for port is done in the next step, because otherwsie recalling with the same port 27017+ would produce faulty results
} # If container exists but is not running, restart it. And do some checks
if(skip<5 && !is.null(dockername)) { # Check/adjust the port
if(!exists('retval', inherits=FALSE)) {
retval <- system(paste('docker inspect', dockername), intern=TRUE)
if(!is.null(attr(retval, 'status'))) stop('Inspecting of docker container "',dockername,'" failed.')
}
contport <- regexpr('"HostPort": "[^"]+"', retval)
contport[contport!=-1][!grepl('"27017/tcp": [',retval[which(contport!=-1)-3], fixed=TRUE)] <- -1
if(sum(contport!=-1)>1 && all(retval[contport!=-1][-1]==retval[contport!=-1][1])) contport[contport!=-1][-1] <- -1
if(sum(contport!=-1)!=1) stop('Error in trying to find this containers path.')
contport <- substring(retval[contport!=-1], contport[contport!=-1]+13,
contport[contport!=-1]+attr(contport, 'match.length')[contport!=-1]-2)
contport <- suppressWarnings(as.numeric(contport))
if(is.null(contport) || is.na(contport) || contport==0) stop('Error in trying to find this containers port number.')
if(port!=0 && port!=contport && (port>contport || (port+plusport*10)<contport))
warning('Restarted docker-container "',dockername,'", but this container is using port ',contport,
' instead of the port provided (',port,')')
port <- contport
} # Check/adjust the port
if(skip<5) { # See if mongo-engine is running, but first do some checks
if(!any(grepl(paste0('Connection to.* port ',port,'.*succeeded!'),
suppressWarnings(system2('nc', args=c('-z',host,port), stdout=TRUE, stderr=TRUE, timeout=5)))))
stop('No connection could be established to host ',host,' on port ', port)
tries <- 0 # Special value: 1e6 means failure to connect, but preOnly. 2e6+n is success after n+1 attempts
if(verbose) cat('Trying to establish connection, port',port)
#browser()
while(tries<100) {
tryCatch(suppressWarnings({
Rmon <- RMongo::mongoDbConnect(db, host, port)
RMongo::dbInsertDocument(Rmon, collection, '{ID: "ConnectionTesting_r78qfuy8asfhaksfhajklsfhajksl"}')
if(nrow(RMongo::dbGetQuery(Rmon, collection, '{}', skip=0, limit=10))<1) stop('ToCatchError')
if(RMongo::dbRemoveQuery(Rmon, collection, '{ID: "ConnectionTesting_r78qfuy8asfhaksfhajklsfhajksl"}')!='ok') stop('ToCatchError')
tries <- tries+2e6
}), error=function(e) {
if(preOnly) {
cat('\nNo response: waiting a bit, meanwhile returning control to caller.\n')
tries <<- 1e6
} else {
cat('.')
tries <<- tries+1
Sys.sleep(tries<100)
}
})
}
if(tries==1e6) {
if(verbose) cat('\n')
return(4)
}
if(tries==100) {
stop('\nMongo-engine seems not to get ready.')
} else if(verbose && tries>=2e6) {
cat('\nSuccesfully connected.')
}
if(verbose || tries>0 && tries<100) cat('\n')
} # See if mongo-engine is running
if(skip<6 && !is.null(inclView)) {
if(missing(dockername)) stop('A viewer can only be included if running mongo in a docker-container, but no dockername is specified')
if(!is.character(inclView) || !inclView %in% c('mongo-express','previous')) stop('Currently, only the mongo-express viewer is supported')
# First step: does a container already exist?
if(!any(grepl(paste0(' ',gsub('.','\\.',dockername, fixed=TRUE),'_view$'),system('docker ps -a', intern=TRUE)))) {
if(inclView=='previous') stop('inclView=="previous" implies a container with the name "', dockername, '_view" already exists, but this is not the case.')
# Do we need to update the image/get a new image?
if(update || !any(grepl(paste0('^',gsub(':',' +',inclView),' '), system('docker image ls', intern=TRUE)))) {
if(verbose) cat('Pulling image ', inclView, ', this might take a while.\n', sep='')
retval <- system(paste('docker pull', inclView), intern = TRUE)
if(!is.null(attr(retval,'status')) ||
!grepl(paste0('(Status: Image is up to date for ',inclView,')|(Status: Downloaded newer image for ',inclView,')'),
retval[length(retval)]))
stop('Error in pulling new image. Output:\n',
paste(retval, sep = '\n'),'\n')
if(verbose) cat(gsub('^Status: ','',retval[length(retval)]),'\n')
}
if(verbose) cat('Creating mongo-container "',dockername,'"\n', sep='')
if(skip>=4) {
# Then we still need to check/decide input
# First image:
retval <- system(paste('docker inspect',dockername), intern=TRUE)
contimagename <- regexpr('"Image": "[^"]+"', retval)
contimagename[!cumsum(grepl('"Config": \\{$', retval))] <- -1 # Only select images named after the Config header
if(sum(contimagename!=-1)!=1) stop('Error in trying to find imagename of container "', dockername,'"')
contimagename <- substring(retval[contimagename!=-1], contimagename[contimagename!=-1]+10,
contimagename[contimagename!=-1]+attr(contimagename, 'match.length')[contimagename!=-1]-2)
if(!is.null(imagename) && contimagename!=imagename)
warning('Docker-container "', dockername, '" is running "', contimagename, '" image, instead of "',
imagename, '" as was supplied. Provided imagename will be ignored.')
imagename <- contimagename
# Path is no consequence to viewer, so next is port:
contport <- regexpr('"HostPort": "[^"]+"', retval)
contport[contport!=-1][!grepl('"27017/tcp": [',retval[which(contport!=-1)-3], fixed=TRUE)] <- -1
if(sum(contport!=-1)>1 && all(retval[contport!=-1][-1]==retval[contport!=-1][1])) contport[contport!=-1][-1] <- -1
if(sum(contport!=-1)!=1) stop('Error in trying to find this containers path.')
contport <- substring(retval[contport!=-1], contport[contport!=-1]+13,
contport[contport!=-1]+attr(contport, 'match.length')[contport!=-1]-2)
contport <- suppressWarnings(as.numeric(contport))
if(is.null(contport) || is.na(contport) || contport==0) stop('Error in trying to find this containers port number.')
if(port!=0 && port!=contport && verbose)
warning('Docker-container "',dockername,'" is mapped to port ',contport,
' instead of the port provided (',port,'). Provided portnumber will be ignored')
port <- contport
}
if(verbose) cat('Creating mongo-container "',dockername,'_view"\n', sep='')
if(!plusviewport && !kickport && !portfree(viewport)) warning('It looks like port',viewport,'is already in use. Continuing, but this function will likely fail.')
while(plusviewport && !portfree(viewport+is.numeric(plusviewport)*plusviewport)) plusviewport <- is.numeric(plusviewport)*plusviewport+1
viewport <- viewport+is.numeric(plusviewport)*plusviewport
if(verbose && is.numeric(plusviewport)) cat('Using port',viewport,'for mongo-viewer-container\n')
if(kickport && !portfree(viewport)) { # If both plusviewport and kickport were TRUE, portfree(viewport) already gives TRUE at this point
retval <- system('docker ps', intern=TRUE)[-1]
tostop <- retval[grepl(paste0(':',viewport,'->8081/tcp'), retval)]
tostop <- substr(tostop, regexpr('[^ ]+$', tostop), nchar(tostop))
tostop <- tostop[!is.na(tostop) & !is.null(tostop) & tostop!='']
if(length(tostop)>1) stop('Error in trying to decide which container to stop')
if(length(tostop)==0) stop('Error in freeing port ',viewport, '. Is this port in use by a non-docker process?')
if(verbose) cat('Freeing port ',viewport,' by stopping docker-container with name "',tostop,'".\n',sep = '')
if(system(paste('docker stop',tostop), intern=TRUE)!=tostop) stop('Unexpected return value when trying to stop "',tostop,'".')
}
retval <- suppressWarnings(system2(command='docker', args=paste0(
'run --link ',dockername,':',imagename,' -p ',viewport,':8081 --name ',dockername, '_view ',
if(!is.null(user)) paste0('-e ME_CONFIG_MONGODB_ADMINUSERNAME="',user,
'" -e ME_CONFIG_MONGODB_ADMINPASSWORD="', pswd,
'" -e ME_CONFIG_BASICAUTH_USERNAME="', user,
'" -e ME_CONFIG_BASICAUTH_PASSWORD="', pswd,'" '),
'-d mongo-express'),
stdout = TRUE, stderr=TRUE))
if(!is.null(attr(retval,'status')) || length(retval)>1 || grepl('[^0-9a-fA-F]', retval)) {
stop('Starting docker-container seemed unsuccesful. Extra details:\n',
'Command run:\n\tdocker ',
paste0('run --link ',dockername,':',imagename,' -p ',viewport,':8081 --name ',dockername, '_view ',
if(!is.null(user)) paste0('-e ME_CONFIG_MONGODB_ADMINUSERNAME="',user,
'" -e ME_CONFIG_MONGODB_ADMINPASSWORD="', pswd,
'" -e ME_CONFIG_BASICAUTH_USERNAME="', user,
'" -e ME_CONFIG_BASICAUTH_PASSWORD="', pswd,'" '),
'-d mongo-express'),
'\nReturn status-code: ',ifelse(is.null(attr(retval,'status')), '0 (success)',attr(retval,'status')),'\n',
'Return text:\n',
paste('\t', retval[1:min(10,length(retval))], collapse='\n'),'\n',
if(length(retval)>10) paste('(truncated', length(retval)-10, 'lines)'))
}
if(verbose) cat('Docker-container "', dockername, '_view" created succesfully.\n', sep='')
}
# Do we need to restart?
if(!any(grepl(paste0(' ',gsub('.','\\.',dockername, fixed=TRUE),'_view$'),system('docker ps', intern=TRUE)))) {
if(!any(grepl(paste0(' ',gsub('.','\\.',dockername, fixed=TRUE),'_view$'),system('docker ps -a', intern=TRUE))))
stop('No container found with name "',dockername,'_view", which is unexpected at this step')
retval <- system(paste0('docker start ', dockername,'_view'), intern=TRUE)
if(!is.null(attr(retval,'status')) || length(retval)!=1 || retval!=paste0(dockername,'_view'))
stop('Restarting container "', dockername, '_view" seemed unsuccesful. Details:\n',
'Command used: docker start ', dockername, '_view\n',
'Return code: ', ifelse(is.null(attr(retval, 'status')), '0 (success)', attr(retval, 'status')), '\n',
'Return text:\n',
paste(retval, collapse='\n'))
if(verbose) cat('Restarted container "',dockername,'_view"\n', sep='')
}
# Checks: pointing to right mongo-instance?
retval <- system(paste0('docker inspect ', dockername, '_view'), intern=TRUE)
if(!is.null(attr(retval, 'status'))) stop('Inspecting of docker container "',dockername,'_view" failed.')
# Checks: imagename, port, docker-linkage
if(inclView!='previous') {
if(!any(grepl(paste0('"Image": "',inclView,'"'), retval, fixed=TRUE)) && verbose)
warning('Restarted docker-container "',dockername,'_view", but this container is not running image ',inclView)
}
contport <- regexpr('"HostPort": "[^"]+"', retval)
contport[contport!=-1][!grepl('"8081/tcp": [',retval[which(contport!=-1)-3], fixed=TRUE)] <- -1
if(sum(contport!=-1)>1 && all(retval[contport!=-1][-1]==retval[contport!=-1][1])) contport[contport!=-1][-1] <- -1
if(sum(contport!=-1)!=1) stop('Error in trying to find this containers path.')
contport <- substring(retval[contport!=-1], contport[contport!=-1]+13,
contport[contport!=-1]+attr(contport, 'match.length')[contport!=-1]-2)
contport <- suppressWarnings(as.numeric(contport))
if(is.null(contport) || is.na(contport) || contport==0) stop('Error in trying to find this containers port number.')
if(viewport!=0 && viewport!=contport && (viewport>contport || (viewport+plusviewport*10)<contport))
warning('Restarted docker-container "',dockername,'", but this container is using port ',contport,
' instead of the port provided (',viewport,')')
viewport <- contport
linked <- grep('"Links": [', retval, fixed=TRUE)
if(length(linked)>1) stop('Error in trying to extract linking-information from container "',dockername,'_view"')
linked <- retval[(linked+1):(linked+grep('],$', retval[linked:length(retval)])[1]-2)]
linkedcont <- gsub(paste0('(^[^"]+"/)|(:/',dockername, '_view.*)'),'',linked)
linkedimg <- gsub(paste0('(^.*',dockername,'_view/)|("$)'),'',linked)
if(dockername!=linkedcont)
warning('Viewer is linked to container "', linkedcont, '" instead of "',dockername,'"')
if(!is.null(imagename) && imagename!=linkedimg)
warning('Viewer is linked to image "', linkedimg, '" instead of "',imagename,'"')
}
if(verbose) cat('\n')
return(monPlus(collection = collection, db = db, host = host, port=port, verbose = verbose,
extraSlots = list(dockername=dockername,
viewername=paste0(dockername,'_view'),
suppliedport=suppliedport,
suppliedviewport=suppliedviewport,
actualviewport=viewport,
DBpath=path)))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.