mueval 0.8 → 0.8.1
raw patch · 9 files changed
+82/−53 lines, 9 files
Files
- HCAR.tex +9/−4
- Mueval/ArgsParse.hs +26/−15
- Mueval/Context.hs +3/−4
- Mueval/Interpreter.hs +10/−8
- README +1/−1
- main.hs +4/−1
- mueval.cabal +1/−1
- tests.sh +17/−14
- watchdog.hs +11/−5
HCAR.tex view
@@ -1,11 +1,12 @@-\begin{hcarentry}[updated]{mueval}+% mueval-Gm.tex+\begin{hcarentry}{mueval} \label{mueval}-\report{Gwern Branwen}%11/08-\participants{Andrea Vezzosi, Daniel Gorin, Spencer Janssen}+\report{Gwern Branwen}%05/10+\participants{Andrea Vezzosi, Daniel Gorin, Spencer Janssen, Adam Vogt} \status{active development} \makeheader -Mueval is a code evaluator for Haskell; it employs the GHC API (as provided by the Hint library~\cref{hint}). It uses a variety of techniques to evaluate arbitrary Haskell expressions safely \& securely. Since it was begun in June 2008, tremendous progress has been made; it is currently used in Lambdabot live in \#haskell). Mueval can also be called from the command-line.+Mueval is a code evaluator for Haskell; it employs the GHC API as provided by the Hint library (\url{http://haskell.org/communities/11-2008/html/report.html#hint}). It uses a variety of techniques to evaluate arbitrary Haskell expressions safely \& securely. Since it was begun in June 2008, tremendous progress has been made; it is currently used in Lambdabot live in \#haskell). Mueval can also be called from the command-line. Mueval features: \begin{itemize}@@ -17,10 +18,14 @@ \item A process-level watchdog, to work around past and future GHC issues with thread-level watchdogs \item Cabalized \end{itemize}++Since the November 2009 HCAR report, the internals have been cleaned up further, a number of minor bugs squashed, tests added, and mueval updated to avoid bitrot.+ We are currently working on the following: \begin{itemize} \item Refactoring modules to render Mueval more useful as a library \item Removing the POSIX-only requirement+\item Merging in Chris Done's \href{http://github.com/chrisdone/mueval-interactive}{mueval-interactive} fork, which powers \url{http://tryhaskell.org/} \end{itemize} \FurtherReading
Mueval/ArgsParse.hs view
@@ -19,6 +19,7 @@ , namedExtensions :: [String] , noImports :: Bool , rLimits :: Bool+ , help :: Bool } deriving Show defaultOptions :: Options@@ -31,26 +32,27 @@ , extensions = False , namedExtensions = [] , noImports = False- , rLimits = False }+ , rLimits = False+ , help = False } options :: [OptDescr (Options -> Options)] options = [Option "p" ["password"] (ReqArg (\u opts -> opts {user = u}) "PASSWORD") "The password for the mubot account. If this is set, mueval will attempt to setuid to the mubot user. This is optional, as it requires the mubot user to be set up properly. (Currently a null-op.)",- Option "t" ["timelimit"]+ Option "t" ["time-limit"] (ReqArg (\t opts -> opts { timeLimit = read t :: Int }) "TIME") "Time limit for compilation and evaluation", - Option "l" ["loadfile"]+ Option "l" ["load-file"] (ReqArg (\e opts -> opts { loadFile = e}) "FILE") "A local file for Mueval to load, providing definitions. Contents are trusted! Do not put anything dubious in it!", Option "m" ["module"] (ReqArg (\m opts -> opts { modules = liftM (m:) (modules opts)}) "MODULE") "A module we should import functions from for evaluation. (Can be given multiple times.)",- Option "n" ["noimports"]+ Option "n" ["no-imports"] (NoArg (\opts -> opts { noImports = True}))- "Whether to import any default modules, such as Prelude; this is useful if you are loading a file which, say, redefines Prelude operators.",+ "Whether to import any default modules, such as Prelude; this is useful if you are loading a file which, say, redefines Prelude operators. This can be subverted by using --load-file.", Option "E" ["Extensions"] (NoArg (\opts -> opts { extensions = True})) "Whether to enable the Glasgow extensions to Haskell '98. Defaults to false, but enabling is useful for QuickCheck.",@@ -63,18 +65,27 @@ Option "i" ["inferred-type"] (NoArg (\opts -> opts { printType = True})) "Whether to enable printing of inferred type and the expression (as Mueval sees it). Defaults to false.",- Option "r" ["rlimits"]+ Option "r" ["resource-limits"] (NoArg (\opts -> opts { rLimits = True}))- "Enable resource limits (using POSIX rlimits). Mueval does not by default since rlimits are broken on many systems." ]+ "Enable resource limits (using POSIX rlimits). Mueval does not by default since rlimits are broken on many systems.",+ Option "h" ["help"]+ (NoArg (\opts -> opts { help = True}))+ "Prints out usage info."+ ] -interpreterOpts :: [String] -> (Options, [String])-interpreterOpts argv =- case getOpt Permute options argv of- (o,n,[]) -> (foldl (flip id) defaultOptions o, n)- (_,_,er) -> error (concat er ++ usageInfo header options)- where header = "Usage: mueval [OPTION...] --expression EXPRESSION..."+interpreterOpts :: [String] -> Either (Bool, String) Options+interpreterOpts argv+ | help opts = Left (True,msg)+ | not (null ers) = Left (False, concat ers ++ msg)+ | otherwise = Right opts+ where (o,_,ers) = getOpt Permute options argv+ msg = usageInfo header options+ opts = foldl (flip id) defaultOptions o +header :: String+header = "Usage: mueval [OPTION...] --expression EXPRESSION..."+ -- | Just give us the end result options; this parsing for -- us. Bonus points for handling UTF.-getOptions :: [String] -> Options-getOptions = fst . interpreterOpts . map Codec.decodeString+getOptions :: [String] -> Either (Bool, String) Options+getOptions = interpreterOpts . map Codec.decodeString
Mueval/Context.hs view
@@ -38,8 +38,6 @@ "Control.Monad.State", "Control.Monad.State", "Control.Monad.Writer",- "Control.Parallel",- "Control.Parallel.Strategies", "Data.Array", "Data.Bits", "Data.Bool",@@ -57,8 +55,9 @@ "Data.Monoid", {- -- Commented out because they are not necessarily available. If anyone misses -- them, perhaps we could look into forcing a dependency on them in the Cabal- -- file. For now, we'll let them be optional.-+ -- file or perhaps enable them via a CLI flag. For now, we'll stash them in a comment.+ "Control.Parallel",+ "Control.Parallel.Strategies", "Data.Number.BigFloat", "Data.Number.CReal", "Data.Number.Dif",
Mueval/Interpreter.hs view
@@ -7,7 +7,7 @@ import Control.Monad.Writer (Any(..),runWriterT,tell) import Data.Char (isDigit) import Data.List (stripPrefix)-import System.Directory (copyFile, makeRelativeToCurrentDirectory, setCurrentDirectory)+import System.Directory (copyFile, makeRelativeToCurrentDirectory, removeFile, setCurrentDirectory) import System.Exit (exitFailure) import System.FilePath.Posix (takeFileName) import qualified Control.Exception.Extensible as E (evaluate,catch,SomeException(..))@@ -21,11 +21,11 @@ InterpreterError(..),GhcError(..)) import Mueval.ArgsParse (Options(..))-import qualified Mueval.Resources as MR (limitResources) +import qualified Mueval.Resources as MR (limitResources) import qualified Mueval.Context as MC (qualifiedModules) {- | The actual calling of Hint functionality. The heart of this just calls- 'eval', but we do so much more - we disable Haskell extensions, + 'eval', but we do so much more - we disable Haskell extensions, hide all packages, make sure one cannot call unimported functions, typecheck, set resource limits for this thread, and do some error handling. -}@@ -39,9 +39,8 @@ reset -- Make sure nothing is available set [installedModulesInScope := False]-+ let lfl' = takeFileName load when (load /= "") $ do liftIO (mvload load)- let lfl' = takeFileName load loadModules [lfl'] -- We need to mangle the String to -- turn a filename into a module.@@ -54,21 +53,24 @@ Just ms -> do let unqualModules = zip ms (repeat Nothing) setImportsQ (unqualModules ++ MC.qualifiedModules) + -- clean up our tmp file here; must be after setImportsQ+ when (load /= "") $ liftIO (removeFile lfl')+ -- we don't check if the expression typechecks -- this way we get an "InterpreterError" we can display etype <- typeOf expr result <- eval expr return (expr, etype, result)- + -- | Wrapper around 'interpreter'; supplies a fresh GHC API session and -- error-handling. The arguments are largely passed on, and the results lightly parsed. interpreterSession :: Options -> IO () interpreterSession opts = do r <- runInterpreter (interpreter opts)- case r of + case r of Left err -> printInterpreterError err Right (e,et,val) -> when (printType opts) (sayIO e >> sayIO et) >> sayIO val- + mvload :: FilePath -> IO () mvload lfl = do canonfile <- makeRelativeToCurrentDirectory lfl liftIO $ copyFile canonfile $ "/tmp/" ++ takeFileName canonfile
README view
@@ -33,7 +33,7 @@ LOADING FROM FILE: Like Lambdabot, Mueval is capable of loading a file and its definitions. This is useful to get a kind of persistence. Suppose you have a file "L.hs", with a function 'bar = (+1)' in it; then 'mueval --loadfile=L.hs --expression="bar 1"' will evaluate to, as one would expect, '2'. -It's worth noting that definitions and module imports in the loaded *ARE NOT* fully checked like the expression is. The resource limits and timeouts still apply, but little else. So if you are dynamically adding functions and module imports, you *MUST* secure them yourself or accept the loss of security. Currently, all known 'evil' expressions cause Mueval to exit with an error (a non-zero exit code), so my advice is to do something like 'mueval --expression foo && echo "\n" >> L.hs && echo foo >> L.hs'.+It's worth noting that definitions and module imports in the loaded *ARE NOT* fully checked like the expression is. The resource limits and timeouts still apply, but little else. So if you are dynamically adding functions and module imports, you *MUST* secure them yourself or accept the loss of security. Currently, all known 'evil' expressions cause Mueval to exit with an error (a non-zero exit code), so my advice is to do something like 'mueval --expression foo && echo "\n" >> L.hs && echo foo >> L.hs'. (That is, only accept new expressions which evaluate successfully.) SUMMARY: Anyway, it's my hope that this will be useful as an example or useful in itself for people endeavoring to fix the Lambdabot situation or just in safely running code period.
main.hs view
@@ -7,8 +7,11 @@ import Mueval.Parallel import Mueval.ArgsParse (getOptions) import System.Environment+import System.Exit main :: IO () main = do args <- getArgs -- force parse errors in main's thread- forkedMain $! getOptions args+ case getOptions args of+ Left (n,s) -> putStrLn s >> if n then exitSuccess else exitFailure+ Right opts -> forkedMain $! opts
mueval.cabal view
@@ -1,5 +1,5 @@ name: mueval-version: 0.8+version: 0.8.1 license: BSD3 license-file: LICENSE
tests.sh view
@@ -32,7 +32,7 @@ m 'join [[1]]' --module Data.List --module Control.Monad --module Data.Char m 'join ["baz"]' --module Data.List --module Data.Char --module Control.Monad m 'map toUpper "foobar"' --module Data.List --module Data.Char --module Control.Monad-m 'tail $ take 50 $ repeat "foo"' --module Data.List --timelimit 3+m 'tail $ take 50 $ repeat "foo"' --module Data.List --time-limit 3 ## This tests whether the SimpleReflect stuff is working. Output should be: "(f 1 (f 2 (f 3 (f 4 (f 5 z)))))\" m 'foldr (\x y -> concat ["(f ",x," ",y,")"]) "z" (map show [1..5])' ## Test 1024-char limit@@ -68,14 +68,14 @@ m '(+1) <$> [1..3]' ## Now let's do file loading echo "module TmpModule (foo, bar) where { foo x = x + 1; bar x = x + 2 }" > "TmpModule.hs"-m '1+1' --loadfile="TmpModule.hs"-m 'foo 1' --loadfile="TmpModule.hs"-m 'bar 1' --loadfile="TmpModule.hs"-m 'foo $ foo 1' --loadfile="TmpModule.hs"+m '1+1' --load-file="TmpModule.hs"+m 'foo 1' --load-file="TmpModule.hs"+m 'bar 1' --load-file="TmpModule.hs"+m 'foo $ foo 1' --load-file="TmpModule.hs" rm "TmpModule.hs"-## Test the --noimports function+## Test the --no-imports function ## TODO: more extensive tests of this-m '()' --noimports+m '()' --no-imports ## Test naming individual syntactic extensions m "let f (id -> x) = x in f 1" -XViewPatterns m "let f :: Int -> State Int (); f (id -> x) = put x in runState (f 1) 1" --module Control.Monad.State -XViewPatterns -XFlexibleContexts@@ -87,7 +87,7 @@ echo "Now let's test various misbehaved expressions \n" && ## test infinite loop m 'let x = x in x' ||-m 'let x y = x 1 in x 1' --timelimit 3 ||+m 'let x y = x 1 in x 1' --time-limit 3 || m 'let x = x + 1 in x' || ## Similarly, but with a strict twist m 'let f :: Int -> Int; f x = f $! (x+1) in f 0' ||@@ -96,13 +96,16 @@ m 'let fix f = let x = f x in x in foldr (.) id (repeat read) $ fix show' || ## Let's stress the time limits m 'let {p x y f = f x y; f x = p x x} in f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f f)))))))))))))))))) f' ||-m " runST (unsafeIOToST (readFile \"/etc/passwd\"))" ||+# Are evil functions in scope?+m 'runST (unsafeIOToST (readFile "/etc/passwd"))' ||+m 'unsafeCoerce (readFile "/etc/passwd"))' || ### Can we bypass the whitelisting by fully qualified module names?-m "Foreign.unsafePerformIO $ readFile \"/etc/passwd\"" ||-m "Data.ByteString.Internal.inlinePerformIO $ readFile \"/etc/passwd\"" ||+m 'Unsafe.unsafeCoerce (readFile "/etc/passwd"))' ||+m 'Foreign.unsafePerformIO $ readFile "/etc/passwd"' ||+m 'Data.ByteString.Internal.inlinePerformIO (readFile "/etc/passwd")' || ## We need a bunch of IO tests, but I guess this will do for now.-m "let foo = readFile \"/etc/passwd\" >>= print in foo" ||-m "writeFile \"tmp.txt\" \"foo bar\"" ||+m 'let foo = readFile "/etc/passwd" >>= print in foo' ||+m 'writeFile "tmp.txt" "foo bar"' || ## Evil array code, should fail (but not with a segfault!) m "array (0::Int, maxBound) [(1000000,'x')]" --module Data.Array ||-echo "Done, apparently successfully"+echo "Done, apparently all evil expressions failed to do evil"
watchdog.hs view
@@ -6,10 +6,12 @@ -- so we specify it as a constant which is a little more generous than the default. module Main where -import System.Environment-import Control.Concurrent-import System.Process-import System.Exit+import Control.Concurrent (forkIO, threadDelay)+import System.Environment (getArgs)+import System.Exit (exitWith, ExitCode(ExitFailure))+import System.Posix.Signals (signalProcess)+import System.Process (getProcessExitCode, runProcess, terminateProcess, waitForProcess)+import System.Process.Internals (withProcessHandle, ProcessHandle__(OpenHandle)) main :: IO () main = do args <- getArgs@@ -18,7 +20,11 @@ threadDelay (7 * 700000) status <- getProcessExitCode hdl case status of - Nothing -> terminateProcess hdl >> exitWith (ExitFailure 1)+ Nothing -> do terminateProcess hdl+ _ <- withProcessHandle hdl (\x -> case x of + OpenHandle pid -> signalProcess 9 pid >> return (undefined, undefined)+ _ -> return (undefined,undefined))+ exitWith (ExitFailure 1) Just a -> exitWith a stat <- waitForProcess hdl exitWith stat