Skip to content
Permalink
Browse files

enable: ggplot2 and rapport package AND adding masked options fns

Enabling rapport resulted in tweaking `options` and `getOptions` to let server owners to specify which options could be modified (and listed). To do so set `sandboxR.disabled.options` option to a character vector of unwanted options.
  • Loading branch information...
daroczig committed May 11, 2012
1 parent c49699f commit 37356a7be2a36066bdb93b469d21c47ade31f0a7
Showing with 88 additions and 20 deletions.
  1. +1 −0 DESCRIPTION
  2. +7 −5 R/blacklist.R
  3. +48 −0 R/masked.functions.R
  4. +2 −0 R/sandbox.R
  5. +14 −11 TODO.md
  6. +16 −4 inst/tests/sandbox.R
@@ -19,3 +19,4 @@ Collate:
'sandbox.R'
'sandboxR.R'
'blacklist.R'
'init.R'
@@ -29,12 +29,14 @@ commands.blacklist <- function(pkg) {
grDevices = c('bitmap', 'bmp', 'cairo_pdf', 'cairo_ps', 'CIDFont', 'dev2bitmap', 'devAskNewPage', 'dev.capabilities', 'dev.capture', 'dev.control', 'dev.copy', 'dev.copy2eps', 'dev.copy2pdf', 'dev.cur', 'dev.flush', 'dev.hold', 'deviceIsInteractive', 'dev.interactive', 'dev.list', 'dev.new', 'dev.next', 'dev.off', 'dev.prev', 'dev.print', 'dev.set', 'dev.size', 'embedFonts', 'getGraphicsEvent', 'getGraphicsEventEnv', 'graphics.off', 'jpeg', 'pdf', 'pdfFonts', 'pdf.options', 'pictex', 'png', 'postscript', 'postscriptFont', 'postscriptFonts', 'ps.options', 'quartz', 'quartzFont', 'quartzFonts', 'quartz.options', 'recordGraphics', 'recordPlot', 'replayPlot', 'savePlot', 'setEPS', 'setGraphicsEventEnv', 'setGraphicsEventHandlers', 'setPS', 'svg', 'tiff', 'Type1Font', 'x11', 'X11', 'X11Font', 'X11Fonts', 'X11.options', 'xfig'),
methods = c('addNextMethod', 'allGenerics', 'allNames', 'asMethodDefinition', 'assignClassDef', 'assignMethodsMetaData', 'balanceMethodsList', 'cacheGenericsMetaData', 'cacheMetaData', 'cacheMethod', 'callGeneric', 'callNextMethod', 'canCoerce', 'checkSlotAssignment', '.classEnv', 'classesToAM', 'classLabel', 'classMetaName', 'className', 'completeClassDefinition', 'completeExtends', 'completeSubclasses', 'conformMethod', 'defaultDumpName', 'defaultPrototype', 'doPrimitiveMethod', '.doTracePrint', 'dumpMethod', 'dumpMethods', 'el', 'elNamed', 'empty.dump', 'emptyMethodsList', 'evalOnLoad', 'evalqOnLoad', 'evalSource', 'existsFunction', 'existsMethod', 'finalDefaultMethod', 'findClass', 'findFunction', 'findMethod', 'findMethods', 'findMethodSignatures', 'findUnique', 'fixPre1.8', 'formalArgs', 'functionBody', 'generic.skeleton', 'getAccess', 'getAllMethods', 'getAllSuperClasses', 'getClass', 'getClassDef', 'getClasses', 'getClassName', 'getClassPackage', 'getDataPart', 'getExtends', 'getFunction', 'getGeneric', 'getGenerics', 'getGroup', 'getGroupMembers', 'getLoadActions', 'getMethod', 'getMethods', 'getMethodsForDispatch', 'getMethodsMetaData', 'getPackageName', 'getProperties', 'getPrototype', 'getRefClass', 'getSlots', 'getSubclasses', 'getValidity', 'getVirtual', 'hasArg', 'hasLoadAction', 'hasMethod', 'hasMethods', '.hasSlot', 'implicitGeneric', 'inheritedSlotNames', 'initFieldArgs', 'initialize', 'initRefFields', 'insertMethod', 'insertSource', 'isClass', 'isClassDef', 'isClassUnion', 'isGeneric', 'isGrammarSymbol', 'isGroup', 'isSealedClass', 'isSealedMethod', 'isVirtualClass', 'isXS3Class', 'languageEl', '.Last.lib', 'linearizeMlist', 'listFromMethods', 'listFromMlist', 'loadMethod', 'Logic', 'makeClassRepresentation', 'makeExtends', 'makeGeneric', 'makeMethodsList', 'makePrototypeFromClassDef', 'makeStandardGeneric', 'matchSignature', 'mergeMethods', 'metaNameUndo', 'MethodAddCoerce', 'methodSignatureMatrix', 'method.skeleton', 'MethodsList', 'MethodsListSelect', 'methodsPackageMetaName', 'missingArg', 'mlistMetaName', 'multipleClasses', 'new', 'newBasic', 'newClassRepresentation', 'newEmptyObject', 'new.env', 'new.packages', 'Ops', 'Ops.data.frame', 'Ops.Date', 'Ops.difftime', 'Ops.factor', 'Ops.numeric_version', 'Ops.ordered', 'Ops.POSIXt', 'Ops.raster', 'Ops.ts', 'packageSlot', 'possibleExtends', 'prohibitGeneric', 'promptClass', 'promptMethods', 'prototype', 'Quote', 'reconcilePropertiesAndPrototype', 'registerImplicitGenerics', 'rematchDefinition', 'removeClass', 'removeGeneric', 'removeMethod', 'removeMethods', 'removeMethodsObject', 'representation', 'requireMethods', 'resetClass', 'resetGeneric', 'S3Class', 'S3Part', 'sealClass', 'seemsS4Object', 'selectMethod', 'selectSuperClasses', '.selectSuperClasses', 'sessionData', 'setAs', 'setClass', 'setClassUnion', 'setDataPart', 'setGeneric', 'setGenericImplicit', 'setGroupGeneric', 'setIs', 'setLoadAction', 'setLoadActions', 'setMethod', 'setOldClass', 'setPackageName', 'setPrimitiveMethods', 'setRefClass', 'setReplaceMethod', 'setValidity', 'showClass', 'showDefault', 'showExtends', 'showMethods', 'showMlist', 'signature', 'SignatureMethod', 'sigToEnv', 'slot', 'slotNames', '.slotNames', 'slotsFromS3', 'substituteDirect', 'substituteFunctionArgs', 'superClassDepth', 'testInheritedMethods', 'testVirtual', 'traceOff', 'traceOn', '.TraceWithMethods', 'tryNew', 'trySilent', 'unRematchDefinition', '.untracedFunction', 'validObject', 'validSlotNames', '.valueClassTest'),
datasets = NULL,
grid = c('draw.details', 'drawDetails', 'drawDetails.recordedGrob', 'grid.record', 'postDrawDetails', 'preDrawDetails', 'recordGrob'),
lattice = c('trellis.device', 'checkArgsAndCall'),
grid = c('draw.details', 'drawDetails', 'drawDetails.recordedGrob', 'grid.record', 'postDrawDetails', 'preDrawDetails', 'recordGrob'),
lattice = c('trellis.device', 'checkArgsAndCall'),
KernSmooth = NULL,
nortest = NULL,
descr = c('file.head', 'fwf2csv'),
outliers = NULL)
nortest = NULL,
descr = c('file.head', 'fwf2csv'),
outliers = NULL,
ggplot2 = c('ggsave', 'safe.call'),
rapport = c('decrypt', 'encrypt', 'eval.msgs', 'evals', 'get.tags', 'grab.chunks', 'has.tags', 'purge.comments', 'rapport.html', 'rapport.odt', 'redraw.recordedplot', 'tpl.check', 'tpl.example', 'tpl.export', 'tpl.info', 'tpl.inputs', 'tpl.list', 'tpl.meta', 'tpl.paths', 'tpl.paths.add', 'tpl.paths.remove', 'tpl.paths.reset', 'tpl.rerun', 'tpl.tangle'))

if (missing(pkg))
pkg <- names(blacklist)
@@ -117,3 +117,51 @@ formula.character <- function(x, env = parent.frame(), ...)

latticeParseFormula <- lattice:::latticeParseFormula
body(latticeParseFormula) <- as.call(c(as.symbol("{"), c(substitute(if (inherits(groups, "formula")) sandbox.pretest(as.character(groups)[2])), as.list(body(latticeParseFormula))[-1])))


rapport <- function(...) {

mc <- match.call(rapport::rapport)

if (!is.null(mc$reproducible) | !is.null(mc$env) | !is.null(mc$header.levels.offset) | !is.null(mc$rapport.mode) | !is.null(mc$graph.output) | !is.null(mc$file.name) | !is.null(mc$file.path) | !is.null(mc$graph.replay) | !is.null(mc$graph.hi.res))
stop('Forbidden parameters provided!')

mc[[1]] <- quote(rapport::rapport)
res <- base::eval(mc)

return(invisible(res))

}


options <- function(...) {

l <- names(list(...))

disabled.options <- base::getOption('sandboxR.disabled.options')

if (length(l) == 0) {
o <- base::options()
return(o[setdiff(names(o), disabled.options)])
}

if (any(l %in% disabled.options))
stop('Not available option(s) queried.')

mc <- match.call()
mc[[1]] <- quote(base::options)
res <- base::eval(mc)

return(invisible(res))

}


getOption <- function(x, default = NULL) {

if (x %in% base::getOption('sandboxR.disabled.options'))
stop('Not available option(s) queried.')

return(base::getOption(x, default))

}
@@ -8,6 +8,8 @@
#' @export
sandbox.env <- function(blacklist = as.character(unlist(commands.blacklist()))) {

## TODO: check if sandboxed env was created before and return that instead of regenerating

## prepare a custom environment with dummy functions
sandboxed.env <- new.env()
for (cmd in blacklist) {
25 TODO.md
@@ -1,19 +1,23 @@
# Major tasks

* ~~Redesign sandboxR to run in an environment with dummy forbidden functions loaded.~~
* _Tidy up unnecessary regexps and checks from `sandbox` thanks to the above!_
* ~~Tidy up unnecessary regexps and checks from `sandbox` thanks to the above!~~

# Allow and create masked functions for the followings
# Check up at least twice!

* masked fn of `latticeParseFormula` is really needed? sandboxR environment seems to handle malicious calls hidden inside without updating that in `lattice` namespace

# Allow (and create) masked functions for the followings

## Base

* ~~get~~, mget
* ~~assign~~
* ~~ls~~
* attach, detach (_wontfix_)
* chartr (_can be done even now by removing masked `paste`, `sprintf` etc._), rawToChar (etc.)
* parse, deparse
* ~~eval~~
* do.call (safe.call from ggplot2) etc.
* exists
* is.call, as.call, call
* ~~library, require~~
@@ -42,15 +46,14 @@ All functions to be revised (nothing permitted ATM).

# Further packages to permit (backlist)

* grid
* lattice
* ~~grid~~
* ~~lattice~~
* parralel (_wontfix_ for RApache environment ATM)
* reshape, reshape2, plyr
* ggplot2
* ~~ggplot2~~
* wordcloud, treemap, scatterplot3d etc.
* nortest
* outliers
* descr
* rapport
* ~~nortest~~
* ~~outliers~~
* ~~descr~~
* ~~rapport~~
* ...

@@ -84,15 +84,27 @@ test_that('ls', {

test_that('library/require', {
expect_output(sandbox('library()'), '.*')
expect_output(sandbox('library(base)'), '.*')
expect_output(sandbox('library(base, verbose = TRUE)'), '.*')
expect_output(sandbox('library("base")'), '.*')
expect_output(sandbox('library(stats)'), '.*')
expect_output(sandbox('suppressWarnings(library(stats, verbose = TRUE))'), '.*')
expect_output(sandbox('library("stats")'), '.*')
expect_error(sandbox('library(RCurl)'))
expect_error(sandbox('library("RCurl")'))
expect_output(sandbox('require(stats)'), '.*')
expect_error(sandbox('require(RCurl)'))
})

context('options')

test_that('allowed options', {
expect_output(sandbox('options(test=10)'), '.*')
expect_output(sandbox('getOption("test")'), '10')
})

test_that('allowed options', {
expect_error(sandbox('options(sandboxR.disabled.options=10)'), '.*')
expect_error(sandbox('getOption("sandboxR.disabled.options")'))
})

context('modified internals')

test_that('lm hacks', {
@@ -111,5 +123,5 @@ test_that('lm hacks', {


test_that('latticeParseFormula', {
expect_error(sandbox(c('x <- c(\'1\', \'readLines("/etc/passwd")\'', "class(x) <- 'formula'", "latticeParseFormula(data=mtcars, model=hp~wt, groups=x)")))
expect_error(sandbox(c('x <- c(\'1\', \'readLines("/etc/passwd")\')', "class(x) <- 'formula'", "latticeParseFormula(data=mtcars, model=hp~wt, groups=x)")))
})

0 comments on commit 37356a7

Please sign in to comment.
You can’t perform that action at this time.