mueval 0.9.3 → 0.9.4
raw patch · 17 files changed
+730/−762 lines, 17 filesdep +muevaldep ~Cabaldep ~QuickCheckdep ~basenew-uploader
Dependencies added: mueval
Dependency ranges changed: Cabal, QuickCheck, base, containers, directory, extensible-exceptions, filepath, hint, mtl, process, show, simple-reflect, unix
Files
- Mueval/ArgsParse.hs +0/−99
- Mueval/Context.hs +0/−120
- Mueval/Interpreter.hs +0/−216
- Mueval/Parallel.hs +0/−50
- Mueval/Resources.hs +0/−53
- app/Main.hs +18/−0
- build.sh +0/−13
- main.hs +0/−17
- mueval.cabal +102/−43
- src/Mueval/ArgsParse.hs +131/−0
- src/Mueval/Context.hs +125/−0
- src/Mueval/Interpreter.hs +269/−0
- src/Mueval/Parallel.hs +13/−0
- src/Mueval/Resources.hs +70/−0
- test/Spec.hs +2/−0
- tests.sh +0/−121
- watchdog.hs +0/−30
− Mueval/ArgsParse.hs
@@ -1,99 +0,0 @@-module Mueval.ArgsParse (Options(..), interpreterOpts) where--import Control.Monad (liftM)-import System.Console.GetOpt--import Mueval.Context (defaultModules, defaultPackages)---- | See the results of --help for information on what each option means.-data Options = Options- { timeLimit :: Int- , modules :: Maybe [String]- , expression :: String- , loadFile :: String- , user :: String- , printType :: Bool- , typeOnly :: Bool- , extensions :: Bool- , namedExtensions :: [String]- , noImports :: Bool- , rLimits :: Bool- , packageTrust :: Bool- , trustedPackages :: [String]- , help :: Bool- } deriving Show--defaultOptions :: Options-defaultOptions = Options { expression = ""- , modules = Just defaultModules- , timeLimit = 5- , user = ""- , loadFile = ""- , printType = False- , typeOnly = False- , extensions = False- , namedExtensions = []- , noImports = False- , rLimits = False- , packageTrust = False- , trustedPackages = defaultPackages- , 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" ["time-limit"]- (ReqArg (\t opts -> opts { timeLimit = read t :: Int }) "TIME")- "Time limit for compilation and evaluation",-- 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" ["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. 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.",- Option "X" ["extension"]- (ReqArg (\e opts -> opts { namedExtensions = e : namedExtensions opts }) "EXTENSION")- "Pass additional flags enabling extensions just like you would to ghc. Example: -XViewPatterns",- Option "e" ["expression"]- (ReqArg (\e opts -> opts { expression = e}) "EXPRESSION")- "The expression to be evaluated.",- 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 "T" ["type-only"]- (NoArg (\opts -> opts { typeOnly = True}))- "Only print the expression and type, don't evaluate the expression. Defaults to false.",- 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.",- Option "S" ["package-trust"]- (NoArg (\opts -> opts {packageTrust = True, namedExtensions = "Safe" : namedExtensions opts}))- "Enable Safe-Haskell package trust system",- Option "s" ["trust"]- (ReqArg (\e opts -> opts {trustedPackages = e : trustedPackages opts}) "PACKAGE")- "Specify a package to be trusted by Safe Haskell (ignored unless -S also present)",- Option "h" ["help"]- (NoArg (\opts -> opts { help = True}))- "Prints out usage info."- ]--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..."
− Mueval/Context.hs
@@ -1,120 +0,0 @@-{-# LANGUAGE CPP #-}-module Mueval.Context (- cleanModules,- defaultModules,- defaultPackages,- qualifiedModules,-) where------------------------------------------------------------------------------------ | Return false if any of the listed modules cannot be found in the whitelist.-cleanModules :: [String] -> Bool-cleanModules = all (`elem` defaultModules)--{- | Modules which we should load by default. These are of course whitelisted.- Specifically, we want the Prelude because otherwise things are horribly- crippled; we want SimpleReflect so we can do neat things (for said neat- things, see- <http://twan.home.fmf.nl/blog/haskell/simple-reflection-of-expressions.details>);- and we want ShowFun to neuter IO stuff even more.- The rest should be safe to import without clashes, according to the Lambdabot- sources. -}-defaultModules :: [String]-defaultModules = ["Prelude",- "ShowFun",- "Debug.SimpleReflect",- "Data.Function",- "Control.Applicative",- "Control.Arrow",- "Control.Monad",- "Control.Monad.Cont",-#if __GLASGOW_HASKELL__ >= 710- "Control.Monad.Except",-#else- "Control.Monad.Error",-#endif- "Control.Monad.Fix",- "Control.Monad.Identity",-#if !MIN_VERSION_base(4,7,0)- "Control.Monad.Instances",-#endif- "Control.Monad.RWS",- "Control.Monad.Reader",- "Control.Monad.State",- "Control.Monad.State",- "Control.Monad.Writer",- "Data.Array",- "Data.Bits",- "Data.Bool",- "Data.Char",- "Data.Complex",- "Data.Dynamic",- "Data.Either",- "Data.Eq",- "Data.Fixed",- "Data.Graph",- "Data.Int",- "Data.Ix",- "Data.List",- "Data.Maybe",- "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 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",- "Data.Number.Fixed",- "Data.Number.Interval",- "Data.Number.Natural",- "Data.Number.Symbolic",- "Math.OEIS",--}- "Data.Ord",- "Data.Ratio",- "Data.Tree",- "Data.Tuple",- "Data.Typeable",- "Data.Word",- "System.Random",- "Test.QuickCheck",- "Text.PrettyPrint.HughesPJ",- "Text.Printf"]--defaultPackages :: [String]-defaultPackages = [ "array"- , "base"- , "bytestring"- , "containers"- ]--{- | Borrowed from Lambdabot, this is the whitelist of modules which should be- safe to import functions from, but which we don't want to import by- default.- FIXME: make these qualified imports. The GHC API & Hint currently do not- support qualified imports.- WARNING: You can import these with --module, certainly, but the onus is on- the user to make sure they fully disambiguate function names; ie:-- > mueval --module Data.Map -e "Prelude.map (+1) [1..100]"--}-qualifiedModules :: [(String, Maybe String)]-qualifiedModules = [--- ("Control.Arrow.Transformer", Just "AT"),--- ("Control.Arrow.Transformer.All", Just "AT"),- ("Data.ByteString", Just "BS"),- ("Data.ByteString.Char8", Just "BSC"),- ("Data.ByteString.Lazy", Just "BSL"),- ("Data.ByteString.Lazy.Char8", Just "BSLC"),- ("Data.Foldable", Just "Data.Foldable"),--- ("Data.Generics", Just "Data.Generics"),- ("Data.IntMap", Just "IM"),- ("Data.IntSet", Just "IS"),- ("Data.Map", Just "M"),- ("Data.Sequence", Just "Data.Sequence"),- ("Data.Set", Just "S"),- ("Data.Traversable", Just "Data.Traversable") ]
− Mueval/Interpreter.hs
@@ -1,216 +0,0 @@-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE FlexibleContexts #-}--- TODO: suggest the convenience functions be put into Hint proper?-module Mueval.Interpreter where--import qualified Control.Exception.Extensible as E (evaluate,catch,SomeException(..))-import Control.Monad (forM_,guard,mplus,unless,when)-import Control.Monad.Trans (MonadIO)-import Control.Monad.Writer (Any(..),runWriterT,tell)-import Data.Char (isDigit)--import System.Directory--import System.Exit (exitFailure)-import System.FilePath.Posix (takeBaseName)-import System.IO (openTempFile)--import Data.List--import Language.Haskell.Interpreter (eval, set, reset, setImportsQ, loadModules, liftIO,- installedModulesInScope, languageExtensions, availableExtensions,- typeOf, setTopLevelModules, runInterpreter,- OptionVal(..), Interpreter,- InterpreterError(..),GhcError(..),- Extension(UnknownExtension))-import Language.Haskell.Interpreter.Unsafe (unsafeSetGhcOption)--import Mueval.ArgsParse (Options(..))-import qualified Mueval.Resources as MR (limitResources)-import qualified Mueval.Context as MC (qualifiedModules)--readExt :: String -> Extension-readExt s = case reads s of- [(e,[])] -> e- _ -> UnknownExtension s--{- | The actual calling of Hint functionality. The heart of this just calls- '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. -}-interpreter :: Options -> Interpreter (String,String,String)-interpreter Options { extensions = exts, namedExtensions = nexts,- rLimits = rlimits,- typeOnly = noEval,- loadFile = load, expression = expr,- packageTrust = trust,- trustedPackages = trustPkgs,- modules = m } = do- let lexts = (guard exts >> glasgowExtensions) ++ map readExt nexts- -- Explicitly adding ImplicitPrelude because of- -- http://darcsden.com/jcpetruzza/hint/issue/1- unless (null lexts) $ set [languageExtensions := (UnknownExtension "ImplicitPrelude" : lexts)]- when trust $ do- unsafeSetGhcOption "-fpackage-trust"- forM_ (trustPkgs >>= words) $ \pkg ->- unsafeSetGhcOption ("-trust " ++ pkg)-- reset -- Make sure nothing is available- set [installedModulesInScope := False]-- -- if we're given a file of definitions, we need to first copy it to a temporary file in /tmp (cpload),- -- then tell Hint to parse/read it, then extract the 'module name' of the file,- -- and tell Hint to expose the module into memory; then we need to store the temporary file's filepath- -- so we can try to clean up after ourselves later.- lfl' <- if (load /= "") then (do { lfl <- liftIO (cpload load);- loadModules [lfl];- -- We need to mangle the String to- -- turn a filename into a module.- setTopLevelModules [takeBaseName load];- return lfl }) else (return "")-- liftIO $ MR.limitResources rlimits-- case m of- Nothing -> return ()- 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 deliberately don't check if the expression typechecks- -- this way we get an "InterpreterError" we can display- etype <- typeOf expr- result <- if noEval- then return ""- else 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- Left err -> printInterpreterError err- Right (e,et,val) -> do when (printType opts)- (sayIO e >> sayIOOneLine et)- sayIO val- where sayIOOneLine = sayIO . unwords . words---- | Given a filepath (containing function definitions), copy it to a temporary file and change directory to it, returning the new filepath.-cpload :: FilePath -> IO FilePath-cpload definitions = do- tmpdir <- getTemporaryDirectory- (tempfile,_) <- System.IO.openTempFile tmpdir "mueval.hs"- liftIO $ copyFile definitions tempfile- setCurrentDirectory tmpdir -- will at least mess up relative links- return tempfile-------------------------------------- Handling and outputting results--- TODO: this whole section is a hack---- | Print the String (presumably the result--- of interpreting something), but only print the first 1024 characters to avoid--- flooding. Lambdabot has a similar limit.-sayIO :: String -> IO ()-sayIO str = do (out,b) <- render 1024 str- putStrLn out- when b exitFailure---- | Oh no, something has gone wrong. If it's a compilation error pretty print--- the first 1024 chars of it and throw an "ExitException"--- otherwise rethrow the exception in String form.-printInterpreterError :: InterpreterError -> IO ()-printInterpreterError (WontCompile errors) =- -- if we get a compilation error we print it directly to avoid \"mueval: ...\"- -- maybe it should go to stderr?- do sayIO $ concatMap (dropLinePosition . errMsg) errors- exitFailure- where- -- each error starts with the line position, which is uninteresting- dropLinePosition e- | Just s <- parseErr e = s- | otherwise = e -- if the parse fails we fallback on printing the whole error- parseErr e = do s <- stripPrefix "<interactive>:" e- skipSpaces =<< (skipNumber =<< skipNumber s)- skip x (y:xs) | x == y = Just xs- | otherwise = Nothing- skip _ _ = Nothing- skipNumber = skip ':' . dropWhile isDigit- skipSpaces xs = let xs' = dropWhile (==' ') xs- in skip '\n' xs' `mplus` return xs'---- other exceptions indicate some problem in Mueval or the environment,--- so we rethrow them for debugging purposes-printInterpreterError other = error (show other)---- Constant-exceptionMsg :: String-exceptionMsg = "*Exception: "---- | Renders the input String including its exceptions using @exceptionMsg@-render :: (Control.Monad.Trans.MonadIO m, Functor m)- => Int -- ^ max number of characters to include- -> String -- ^ input- -> m (String, Bool) -- ^ ( output, @True@ if we found an exception )-render i xs =- do (out,Any b) <- runWriterT $ render' i (toStream xs)- return (out,b)- where- render' n _ | n <= 0 = return ""- render' n s = render'' n =<< liftIO s-- render'' _ End = return ""- render'' n (Cons x s) = fmap (x:) $ render' (n-1) s- render'' n (Exception s) = do- tell (Any True)- fmap (take n exceptionMsg ++) $ render' (n - length exceptionMsg) s--data Stream = Cons Char (IO Stream) | Exception (IO Stream) | End--toStream :: String -> IO Stream-toStream str = E.evaluate (uncons str) `E.catch`- \(E.SomeException e) -> return . Exception . toStream . show $ e- where uncons [] = End- uncons (x:xs) = x `seq` Cons x (toStream xs)---- Copied from old hint, removed from hint since 0.5.0.-glasgowExtensions :: [Extension]-glasgowExtensions = intersect availableExtensions exts612 -- works also for 608 and 610- where exts612 = map readExt ["PrintExplicitForalls",- "ForeignFunctionInterface",- "UnliftedFFITypes",- "GADTs",- "ImplicitParams",- "ScopedTypeVariables",- "UnboxedTuples",- "TypeSynonymInstances",- "StandaloneDeriving",- "DeriveDataTypeable",- "FlexibleContexts",- "FlexibleInstances",- "ConstrainedClassMethods",- "MultiParamTypeClasses",- "FunctionalDependencies",- "MagicHash",- "PolymorphicComponents",- "ExistentialQuantification",- "UnicodeSyntax",- "PostfixOperators",- "PatternGuards",- "LiberalTypeSynonyms",- "ExplicitForAll",- "RankNTypes",- "ImpredicativeTypes",- "TypeOperators",- "RecursiveDo",- "DoRec",- "ParallelListComp",- "EmptyDataDecls",- "KindSignatures",- "GeneralizedNewtypeDeriving",- "TypeFamilies" ]
− Mueval/Parallel.hs
@@ -1,50 +0,0 @@-module Mueval.Parallel where--import Control.Concurrent (forkIO, killThread, myThreadId, threadDelay, throwTo, ThreadId)-import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, MVar)-import Control.Exception.Extensible as E (ErrorCall(..),SomeException,catch)-import Control.Monad (void)-import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))-import System.Posix.Signals (sigXCPU, installHandler, Handler(CatchOnce))--import Mueval.Interpreter-import Mueval.ArgsParse---- | Fork off a thread which will sleep and then kill off the specified thread.-watchDog :: Int -> ThreadId -> IO ()-watchDog tout tid = do _ <- installHandler sigXCPU- (CatchOnce- $ throwTo tid $ ErrorCall "Time limit exceeded.") Nothing- _ <- forkIO $ do- threadDelay (tout * 700000)- -- Time's up. It's a good day to die.- throwTo tid (ErrorCall "Time limit exceeded")- killThread tid -- Die now, srsly.- error "Time expired"- return () -- Never reached. Either we error out here- -- or the evaluation thread finishes.---- | A basic blocking operation.-block :: (t -> MVar a -> IO t1) -> t -> IO a-block f opts = do mvar <- newEmptyMVar- _ <- f opts mvar- takeMVar mvar -- block until ErrorCall, or forkedMain succeeds---- | Using MVars, block on 'forkedMain' until it finishes.-forkedMain :: Options -> IO ()-forkedMain opts = void (block forkedMain' opts)----- | Set a 'watchDog' on this thread, and then continue on with whatever.-forkedMain' :: Options -> MVar String -> IO ThreadId-forkedMain' opts mvar = do mainId <- myThreadId- watchDog (timeLimit opts) mainId- hSetBuffering stdout NoBuffering-- -- Our modules and expression are set up. Let's do stuff.- forkIO $ (interpreterSession (checkImport opts)- >> putMVar mvar "Done.")- `E.catch` \e -> throwTo mainId (e::SomeException)- -- bounce exceptions to the main thread,- -- so they are reliably printed out- where checkImport x = if noImports x then x{modules=Nothing} else x
− Mueval/Resources.hs
@@ -1,53 +0,0 @@-module Mueval.Resources (limitResources) where--import Control.Monad (when)-import System.Posix.Process (nice)-import System.Posix.Resource -- (Resource(..), ResourceLimits, setResourceLimit)---- | Pull together several methods of reducing priority and easy access to resources:--- 'nice', and the rlimit bindings,--- If called with False, 'limitResources' will not use POSIX rlimits.-limitResources :: Bool -> IO ()-limitResources rlimit = do nice 20 -- Set our process priority way down- when rlimit $ mapM_ (uncurry setResourceLimit) limits---- | Set all the available rlimits.--- These values have been determined through trial-and-error-stackSizeLimitSoft, stackSizeLimitHard, totalMemoryLimitSoft, totalMemoryLimitHard,- dataSizeLimitSoft, openFilesLimitSoft, openFilesLimitHard, fileSizeLimitSoft, fileSizeLimitHard,- dataSizeLimitHard, cpuTimeLimitSoft, cpuTimeLimitHard, coreSizeLimitSoft, coreSizeLimitHard, zero :: ResourceLimit-totalMemoryLimitSoft = dataSizeLimitSoft-totalMemoryLimitHard = dataSizeLimitHard--- These limits seem to be useless?-stackSizeLimitSoft = zero-stackSizeLimitHard = zero--- We allow a few files to be opened, such as package.conf, because they are necessary. This--- doesn't seem to be security problem because it'll be opened at the module--- stage, before code ever evaluates. I hope.-openFilesLimitSoft = openFilesLimitHard-openFilesLimitHard = ResourceLimit 7--- TODO: It would be nice to set these to zero, but right now Hint gets around the--- insecurity of the GHC API by writing stuff out to a file in /tmp, so we need--- to allow our compiled binary to do file I/O... :( But at least we can still limit--- how much we write out!-fileSizeLimitSoft = fileSizeLimitHard-fileSizeLimitHard = ResourceLimit 10800-dataSizeLimitSoft = dataSizeLimitHard-dataSizeLimitHard = ResourceLimit $ 6^(12::Int)--- These should not be identical, to give the XCPU handler time to trigger-cpuTimeLimitSoft = ResourceLimit 4-cpuTimeLimitHard = ResourceLimit 5-coreSizeLimitSoft = coreSizeLimitHard-coreSizeLimitHard = zero---- convenience-zero = ResourceLimit 0--limits :: [(Resource, ResourceLimits)]-limits = [ (ResourceStackSize, ResourceLimits stackSizeLimitSoft stackSizeLimitHard)- , (ResourceTotalMemory, ResourceLimits totalMemoryLimitSoft totalMemoryLimitHard)- , (ResourceOpenFiles, ResourceLimits openFilesLimitSoft openFilesLimitHard)- , (ResourceFileSize, ResourceLimits fileSizeLimitSoft fileSizeLimitHard)- , (ResourceDataSize, ResourceLimits dataSizeLimitSoft dataSizeLimitHard)- , (ResourceCoreFileSize, ResourceLimits coreSizeLimitSoft coreSizeLimitHard)- , (ResourceCPUTime, ResourceLimits cpuTimeLimitSoft cpuTimeLimitHard)]
+ app/Main.hs view
@@ -0,0 +1,18 @@+-- TODO:+-- Need to add user switching. Perhaps using seteuid and setegid? See+-- <http://www.opengroup.org/onlinepubs/009695399/functions/seteuid.html> &+-- <http://www.opengroup.org/onlinepubs/009695399/functions/setegid.html>+module Main (main) where++import Mueval.ArgsParse (interpreterOpts)+import Mueval.Parallel (runMueval)+import System.Environment+import System.Exit++main :: IO ()+main = do+ args <- getArgs+ -- force parse errors in main's thread+ case interpreterOpts args of+ Left (n, s) -> putStrLn s >> if n then exitSuccess else exitFailure+ Right opts -> runMueval opts
− build.sh
@@ -1,13 +0,0 @@-#!/bin/sh-# Abort if any commands aren't successful-set -e-# Build-(runhaskell Setup configure --user && runhaskell Setup build && runhaskell Setup haddock && runhaskell Setup install || exit) &&-# Run the test suite with various options-echo "\n...Single-threaded tests....\n" &&-sh tests.sh &&-echo "\n...Rerun the tests with multiple threads...\n" &&-sh tests.sh +RTS -N4 -RTS &&-echo "\n...Rerun tests with resource limits enabled...\n" &&-sh tests.sh --rlimits &&-echo "\n...Done, apparently everything worked!"
− main.hs
@@ -1,17 +0,0 @@--- TODO:--- Need to add user switching. Perhaps using seteuid and setegid? See--- <http://www.opengroup.org/onlinepubs/009695399/functions/seteuid.html> &--- <http://www.opengroup.org/onlinepubs/009695399/functions/setegid.html>-module Main (main) where--import Mueval.Parallel-import Mueval.ArgsParse (interpreterOpts)-import System.Environment-import System.Exit--main :: IO ()-main = do args <- getArgs- -- force parse errors in main's thread- case interpreterOpts args of- Left (n,s) -> putStrLn s >> if n then exitSuccess else exitFailure- Right opts -> forkedMain $! opts
mueval.cabal view
@@ -1,51 +1,110 @@-name: mueval-version: 0.9.3--license: BSD3-license-file: LICENSE-author: Gwern-maintainer: Gwern <gwern@gwern.net>--category: Development, Language-synopsis: Safely evaluate pure Haskell expressions-description: Mueval is a Haskell interpreter. It- uses the GHC API to evaluate arbitrary Haskell expressions.- Importantly, mueval takes many precautions to defang and avoid \"evil\"- code. It uses resource limits, whitelisted modules and Safe Haskell,- special Show instances for IO, threads, processes, and changes of directory- to sandbox the Haskell code.- .- It is, in short, intended to be a standalone version of Lambdabot's famous- evaluation functionality. For examples and explanations, please see the README file.- .- Mueval is POSIX-only.-homepage: https://github.com/gwern/mueval+cabal-version: 1.12+name: mueval+version: 0.9.4+license: BSD3+license-file: LICENSE+maintainer: Terence Ng <stoicism03@gmail.com>+author: Gwern <gwern@gwern.net>+tested-with: ghc ==6.10.1+homepage: https://github.com/TerenceNg03/mueval#readme+bug-reports: https://github.com/TerenceNg03/mueval/issues+synopsis: Safely evaluate pure Haskell expressions+description:+ Mueval is a Haskell interpreter. It uses the GHC API to evaluate arbitrary Haskell expressions. Importantly, mueval takes many precautions to defang and avoid \"evil\" code. It uses resource limits, whitelisted modules and Safe Haskell, special Show instances for IO, threads, processes, and changes of directory to sandbox the Haskell code. . It is, in short, intended to be a standalone version of Lambdabot's famous evaluation functionality. For examples and explanations, please see the README file. . Mueval is POSIX-only. -build-type: Simple-cabal-version: >= 1.6-tested-with: GHC==6.10.1+category: Development, Language+build-type: Simple+extra-source-files:+ README.md+ HCAR.tex -data-files: README.md, HCAR.tex-extra-source-files: build.sh, tests.sh+source-repository head+ type: git+ location: https://github.com/TerenceNg03/mueval library- exposed-modules: Mueval.Parallel, Mueval.Context, Mueval.Interpreter,- Mueval.ArgsParse, Mueval.Resources- build-depends: base>= 4.5 && < 5, containers, directory, mtl>2, filepath, unix, process,- hint>=0.3.1, show>=0.3, Cabal, extensible-exceptions, simple-reflect,- QuickCheck- ghc-options: -Wall -static+ exposed-modules:+ Mueval.ArgsParse+ Mueval.Context+ Mueval.Interpreter+ Mueval.Parallel+ Mueval.Resources -executable mueval-core- main-is: main.hs- build-depends: base- ghc-options: -Wall -static -threaded+ hs-source-dirs: src+ other-modules: Paths_mueval+ default-language: Haskell2010+ ghc-options:+ -Wall -Wcompat -Widentities -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wmissing-export-lists+ -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ -static + build-depends:+ Cabal >=3.8.1.0 && <3.9,+ QuickCheck >=2.14.3 && <2.15,+ base >=4.5 && <5,+ containers >=0.6.7 && <0.7,+ directory >=1.3.7.1 && <1.4,+ extensible-exceptions >=0.1.1.4 && <0.2,+ filepath >=1.4.2.2 && <1.5,+ hint >=0.9.0.7 && <0.10,+ mtl >=2.2.2 && <2.3,+ process >=1.6.16.0 && <1.7,+ show >=0.6 && <0.7,+ simple-reflect >=0.3.3 && <0.4,+ unix >=2.7.3 && <2.8+ executable mueval- main-is: watchdog.hs- build-depends: base- ghc-options: -Wall -static -threaded+ main-is: Main.hs+ hs-source-dirs: app+ other-modules: Paths_mueval+ default-language: Haskell2010+ ghc-options:+ -Wall -Wcompat -Widentities -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wmissing-export-lists+ -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ -static -threaded -rtsopts -with-rtsopts=-N -source-repository head- type: git- location: git://github.com/gwern/mueval.git+ build-depends:+ Cabal >=3.8.1.0 && <3.9,+ QuickCheck >=2.14.3 && <2.15,+ base >=4.5 && <5,+ containers >=0.6.7 && <0.7,+ directory >=1.3.7.1 && <1.4,+ extensible-exceptions >=0.1.1.4 && <0.2,+ filepath >=1.4.2.2 && <1.5,+ hint >=0.9.0.7 && <0.10,+ mtl >=2.2.2 && <2.3,+ mueval,+ process >=1.6.16.0 && <1.7,+ show >=0.6 && <0.7,+ simple-reflect >=0.3.3 && <0.4,+ unix >=2.7.3 && <2.8++test-suite mueval-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ other-modules: Paths_mueval+ default-language: Haskell2010+ ghc-options:+ -Wall -Wcompat -Widentities -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wmissing-export-lists+ -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ -static -threaded -rtsopts -with-rtsopts=-N++ build-depends:+ Cabal >=3.8.1.0 && <3.9,+ QuickCheck >=2.14.3 && <2.15,+ base >=4.5 && <5,+ containers >=0.6.7 && <0.7,+ directory >=1.3.7.1 && <1.4,+ extensible-exceptions >=0.1.1.4 && <0.2,+ filepath >=1.4.2.2 && <1.5,+ hint >=0.9.0.7 && <0.10,+ mtl >=2.2.2 && <2.3,+ mueval,+ process >=1.6.16.0 && <1.7,+ show >=0.6 && <0.7,+ simple-reflect >=0.3.3 && <0.4,+ unix >=2.7.3 && <2.8
+ src/Mueval/ArgsParse.hs view
@@ -0,0 +1,131 @@+module Mueval.ArgsParse (Options (..), interpreterOpts) where++import Control.Monad (liftM)+import System.Console.GetOpt++import Mueval.Context (defaultModules, defaultPackages)++-- | See the results of --help for information on what each option means.+data Options = Options+ { timeLimit :: Int+ , modules :: Maybe [String]+ , expression :: String+ , loadFile :: String+ , user :: String+ , printType :: Bool+ , typeOnly :: Bool+ , extensions :: Bool+ , namedExtensions :: [String]+ , noImports :: Bool+ , rLimits :: Bool+ , packageTrust :: Bool+ , trustedPackages :: [String]+ , help :: Bool+ }+ deriving (Show)++defaultOptions :: Options+defaultOptions =+ Options+ { expression = ""+ , modules = Just defaultModules+ , timeLimit = 5+ , user = ""+ , loadFile = ""+ , printType = False+ , typeOnly = False+ , extensions = False+ , namedExtensions = []+ , noImports = False+ , rLimits = False+ , packageTrust = False+ , trustedPackages = defaultPackages+ , 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"+ ["time-limit"]+ (ReqArg (\t opts -> opts{timeLimit = read t :: Int}) "TIME")+ "Time limit for compilation and evaluation"+ , 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"+ ["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. 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."+ , Option+ "X"+ ["extension"]+ (ReqArg (\e opts -> opts{namedExtensions = e : namedExtensions opts}) "EXTENSION")+ "Pass additional flags enabling extensions just like you would to ghc. Example: -XViewPatterns"+ , Option+ "e"+ ["expression"]+ (ReqArg (\e opts -> opts{expression = e}) "EXPRESSION")+ "The expression to be evaluated."+ , 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+ "T"+ ["type-only"]+ (NoArg (\opts -> opts{typeOnly = True}))+ "Only print the expression and type, don't evaluate the expression. Defaults to false."+ , 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."+ , Option+ "S"+ ["package-trust"]+ (NoArg (\opts -> opts{packageTrust = True, namedExtensions = "Safe" : namedExtensions opts}))+ "Enable Safe-Haskell package trust system"+ , Option+ "s"+ ["trust"]+ (ReqArg (\e opts -> opts{trustedPackages = e : trustedPackages opts}) "PACKAGE")+ "Specify a package to be trusted by Safe Haskell (ignored unless -S also present)"+ , Option+ "h"+ ["help"]+ (NoArg (\opts -> opts{help = True}))+ "Prints out usage info."+ ]++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..."
+ src/Mueval/Context.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE CPP #-}++module Mueval.Context (+ cleanModules,+ defaultModules,+ defaultPackages,+ qualifiedModules,+) where++-----------------------------------------------------------------------------++-- | Return false if any of the listed modules cannot be found in the whitelist.+cleanModules :: [String] -> Bool+cleanModules = all (`elem` defaultModules)++{- | Modules which we should load by default. These are of course whitelisted.+ Specifically, we want the Prelude because otherwise things are horribly+ crippled; we want SimpleReflect so we can do neat things (for said neat+ things, see+ <http://twan.home.fmf.nl/blog/haskell/simple-reflection-of-expressions.details>);+ and we want ShowFun to neuter IO stuff even more.+ The rest should be safe to import without clashes, according to the Lambdabot+ sources.+-}+defaultModules :: [String]+defaultModules =+ [ "Prelude"+ , "ShowFun"+ , "Debug.SimpleReflect"+ , "Data.Function"+ , "Control.Applicative"+ , "Control.Arrow"+ , "Control.Monad"+ , "Control.Monad.Cont"+#if __GLASGOW_HASKELL__ >= 710+ , "Control.Monad.Except"+#else+ , "Control.Monad.Error"+#endif+ , "Control.Monad.Fix"+ , "Control.Monad.Identity"+#if !MIN_VERSION_base(4,7,0)+ , "Control.Monad.Instances"+#endif+ , "Control.Monad.RWS"+ , "Control.Monad.Reader"+ , "Control.Monad.State"+ , "Control.Monad.State"+ , "Control.Monad.Writer"+ , "Data.Array"+ , "Data.Bits"+ , "Data.Bool"+ , "Data.Char"+ , "Data.Complex"+ , "Data.Dynamic"+ , "Data.Either"+ , "Data.Eq"+ , "Data.Fixed"+ , "Data.Graph"+ , "Data.Int"+ , "Data.Ix"+ , "Data.List"+ , "Data.Maybe"+ , "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 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",+ "Data.Number.Fixed",+ "Data.Number.Interval",+ "Data.Number.Natural",+ "Data.Number.Symbolic",+ "Math.OEIS",+ -}+ "Data.Ord"+ , "Data.Ratio"+ , "Data.Tree"+ , "Data.Tuple"+ , "Data.Typeable"+ , "Data.Word"+ , "System.Random"+ , "Test.QuickCheck"+ , "Text.PrettyPrint.HughesPJ"+ , "Text.Printf"+ ]++defaultPackages :: [String]+defaultPackages =+ [ "array"+ , "base"+ , "bytestring"+ , "containers"+ ]++{- | Borrowed from Lambdabot, this is the whitelist of modules which should be+ safe to import functions from, but which we don't want to import by+ default.+ FIXME: make these qualified imports. The GHC API & Hint currently do not+ support qualified imports.+ WARNING: You can import these with --module, certainly, but the onus is on+ the user to make sure they fully disambiguate function names; ie:++ > mueval --module Data.Map -e "Prelude.map (+1) [1..100]"+-}+qualifiedModules :: [(String, Maybe String)]+qualifiedModules =+ [ -- ("Control.Arrow.Transformer", Just "AT"),+ -- ("Control.Arrow.Transformer.All", Just "AT"),+ ("Data.ByteString", Just "BS")+ , ("Data.ByteString.Char8", Just "BSC")+ , ("Data.ByteString.Lazy", Just "BSL")+ , ("Data.ByteString.Lazy.Char8", Just "BSLC")+ , ("Data.Foldable", Just "Data.Foldable")+ , -- ("Data.Generics", Just "Data.Generics"),+ ("Data.IntMap", Just "IM")+ , ("Data.IntSet", Just "IS")+ , ("Data.Map", Just "M")+ , ("Data.Sequence", Just "Data.Sequence")+ , ("Data.Set", Just "S")+ , ("Data.Traversable", Just "Data.Traversable")+ ]
+ src/Mueval/Interpreter.hs view
@@ -0,0 +1,269 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternGuards #-}++-- TODO: suggest the convenience functions be put into Hint proper?+module Mueval.Interpreter where++import qualified Control.Exception.Extensible as E (SomeException (..), catch, evaluate)+import Control.Monad (forM_, guard, mplus, unless, when)+import Control.Monad.Trans (MonadIO)+import Control.Monad.Writer (runWriterT, tell)+import Data.Char (isDigit)++import System.Directory++import System.Exit (exitFailure)+import System.FilePath.Posix (takeBaseName)+import System.IO (openTempFile)++import Data.List+import Data.Monoid (Any (..))++import Language.Haskell.Interpreter (+ Extension (UnknownExtension),+ GhcError (..),+ Interpreter,+ InterpreterError (..),+ OptionVal (..),+ availableExtensions,+ eval,+ installedModulesInScope,+ languageExtensions,+ liftIO,+ loadModules,+ reset,+ runInterpreter,+ set,+ setImportsQ,+ setTopLevelModules,+ typeOf,+ )+import Language.Haskell.Interpreter.Unsafe (unsafeSetGhcOption)++import Mueval.ArgsParse (Options (..))+import qualified Mueval.Context as MC (qualifiedModules)+import qualified Mueval.Resources as MR (limitResources)++readExt :: String -> Extension+readExt s = case reads s of+ [(e, [])] -> e+ _ -> UnknownExtension s++{- | The actual calling of Hint functionality. The heart of this just calls+ '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.+-}+interpreter :: Options -> Interpreter (String, String, String)+interpreter+ Options+ { extensions = exts+ , namedExtensions = nexts+ , rLimits = rlimits+ , typeOnly = noEval+ , loadFile = load+ , expression = expr+ , packageTrust = trust+ , trustedPackages = trustPkgs+ , modules = m+ } = do+ let lexts = (guard exts >> glasgowExtensions) ++ map readExt nexts+ -- Explicitly adding ImplicitPrelude because of+ -- http://darcsden.com/jcpetruzza/hint/issue/1+ unless (null lexts) $ set [languageExtensions := (UnknownExtension "ImplicitPrelude" : lexts)]+ when trust $ do+ unsafeSetGhcOption "-fpackage-trust"+ forM_ (trustPkgs >>= words) $ \pkg ->+ unsafeSetGhcOption ("-trust " ++ pkg)++ reset -- Make sure nothing is available+ set [installedModulesInScope := False]++ -- if we're given a file of definitions, we need to first copy it to a temporary file in /tmp (cpload),+ -- then tell Hint to parse/read it, then extract the 'module name' of the file,+ -- and tell Hint to expose the module into memory; then we need to store the temporary file's filepath+ -- so we can try to clean up after ourselves later.+ lfl' <-+ if (load /= "")+ then+ ( do+ lfl <- liftIO (cpload load)+ loadModules [lfl]+ -- We need to mangle the String to+ -- turn a filename into a module.+ setTopLevelModules [takeBaseName load]+ return lfl+ )+ else (return "")++ liftIO $ MR.limitResources rlimits++ case m of+ Nothing -> return ()+ 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 deliberately don't check if the expression typechecks+ -- this way we get an "InterpreterError" we can display+ etype <- typeOf expr+ result <-+ if noEval+ then return ""+ else 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+ Left err -> printInterpreterError err+ Right (e, et, val) -> do+ when+ (printType opts)+ (sayIO e >> sayIOOneLine et)+ sayIO val+ where+ sayIOOneLine = sayIO . unwords . words++-- | Given a filepath (containing function definitions), copy it to a temporary file and change directory to it, returning the new filepath.+cpload :: FilePath -> IO FilePath+cpload definitions = do+ tmpdir <- getTemporaryDirectory+ (tempfile, _) <- System.IO.openTempFile tmpdir "mueval.hs"+ liftIO $ copyFile definitions tempfile+ setCurrentDirectory tmpdir -- will at least mess up relative links+ return tempfile++---------------------------------+-- Handling and outputting results+-- TODO: this whole section is a hack++{- | Print the String (presumably the result+ of interpreting something), but only print the first 1024 characters to avoid+ flooding. Lambdabot has a similar limit.+-}+sayIO :: String -> IO ()+sayIO str = do+ (out, b) <- render 1024 str+ putStrLn out+ when b exitFailure++{- | Oh no, something has gone wrong. If it's a compilation error pretty print+ the first 1024 chars of it and throw an "ExitException"+ otherwise rethrow the exception in String form.+-}+printInterpreterError :: InterpreterError -> IO ()+printInterpreterError (WontCompile errors) =+ -- if we get a compilation error we print it directly to avoid \"mueval: ...\"+ -- maybe it should go to stderr?+ do+ sayIO $ concatMap (dropLinePosition . errMsg) errors+ exitFailure+ where+ -- each error starts with the line position, which is uninteresting+ dropLinePosition e+ | Just s <- parseErr e = s+ | otherwise = e -- if the parse fails we fallback on printing the whole error+ parseErr e = do+ s <- stripPrefix "<interactive>:" e+ skipSpaces =<< (skipNumber =<< skipNumber s)+ skip x (y : xs)+ | x == y = Just xs+ | otherwise = Nothing+ skip _ _ = Nothing+ skipNumber = skip ':' . dropWhile isDigit+ skipSpaces xs =+ let xs' = dropWhile (== ' ') xs+ in skip '\n' xs' `mplus` return xs'++-- other exceptions indicate some problem in Mueval or the environment,+-- so we rethrow them for debugging purposes+printInterpreterError other = error (show other)++-- Constant+exceptionMsg :: String+exceptionMsg = "*Exception: "++-- | Renders the input String including its exceptions using @exceptionMsg@+render ::+ (Control.Monad.Trans.MonadIO m, Functor m) =>+ -- | max number of characters to include+ Int ->+ -- | input+ String ->+ -- | ( output, @True@ if we found an exception )+ m (String, Bool)+render i xs =+ do+ (out, Any b) <- runWriterT $ render' i (toStream xs)+ return (out, b)+ where+ render' n _ | n <= 0 = return ""+ render' n s = render'' n =<< liftIO s++ render'' _ End = return ""+ render'' n (Cons x s) = fmap (x :) $ render' (n - 1) s+ render'' n (Exception s) = do+ tell (Any True)+ fmap (take n exceptionMsg ++) $ render' (n - length exceptionMsg) s++data Stream = Cons Char (IO Stream) | Exception (IO Stream) | End++toStream :: String -> IO Stream+toStream str =+ E.evaluate (uncons str)+ `E.catch` \(E.SomeException e) -> return . Exception . toStream . show $ e+ where+ uncons [] = End+ uncons (x : xs) = x `seq` Cons x (toStream xs)++-- Copied from old hint, removed from hint since 0.5.0.+glasgowExtensions :: [Extension]+glasgowExtensions = intersect availableExtensions exts612 -- works also for 608 and 610+ where+ exts612 =+ map+ readExt+ [ "PrintExplicitForalls"+ , "ForeignFunctionInterface"+ , "UnliftedFFITypes"+ , "GADTs"+ , "ImplicitParams"+ , "ScopedTypeVariables"+ , "UnboxedTuples"+ , "TypeSynonymInstances"+ , "StandaloneDeriving"+ , "DeriveDataTypeable"+ , "FlexibleContexts"+ , "FlexibleInstances"+ , "ConstrainedClassMethods"+ , "MultiParamTypeClasses"+ , "FunctionalDependencies"+ , "MagicHash"+ , "PolymorphicComponents"+ , "ExistentialQuantification"+ , "UnicodeSyntax"+ , "PostfixOperators"+ , "PatternGuards"+ , "LiberalTypeSynonyms"+ , "ExplicitForAll"+ , "RankNTypes"+ , "ImpredicativeTypes"+ , "TypeOperators"+ , "RecursiveDo"+ , "DoRec"+ , "ParallelListComp"+ , "EmptyDataDecls"+ , "KindSignatures"+ , "GeneralizedNewtypeDeriving"+ , "TypeFamilies"+ ]
+ src/Mueval/Parallel.hs view
@@ -0,0 +1,13 @@+module Mueval.Parallel (runMueval) where++import Control.Monad (void)++import Mueval.ArgsParse (Options (modules, noImports, timeLimit))+import Mueval.Interpreter (interpreterSession)+import System.Timeout (timeout)++runMueval :: Options -> IO ()+runMueval opts =+ let time = timeLimit opts * 1000000+ checkImport x = if noImports x then x{modules = Nothing} else x+ in void $ timeout time $ interpreterSession (checkImport opts)
+ src/Mueval/Resources.hs view
@@ -0,0 +1,70 @@+module Mueval.Resources (limitResources) where++import Control.Monad (when)+import System.Posix.Process (nice)+import System.Posix.Resource -- (Resource(..), ResourceLimits, setResourceLimit)++{- | Pull together several methods of reducing priority and easy access to resources:+ 'nice', and the rlimit bindings,+ If called with False, 'limitResources' will not use POSIX rlimits.+-}+limitResources :: Bool -> IO ()+limitResources rlimit = do+ nice 20 -- Set our process priority way down+ when rlimit $ mapM_ (uncurry setResourceLimit) limits++{- | Set all the available rlimits.+ These values have been determined through trial-and-error+-}+stackSizeLimitSoft+ , stackSizeLimitHard+ , totalMemoryLimitSoft+ , totalMemoryLimitHard+ , dataSizeLimitSoft+ , openFilesLimitSoft+ , openFilesLimitHard+ , fileSizeLimitSoft+ , fileSizeLimitHard+ , dataSizeLimitHard+ , cpuTimeLimitSoft+ , cpuTimeLimitHard+ , coreSizeLimitSoft+ , coreSizeLimitHard+ , zero ::+ ResourceLimit+totalMemoryLimitSoft = dataSizeLimitSoft+totalMemoryLimitHard = dataSizeLimitHard+-- These limits seem to be useless?+stackSizeLimitSoft = zero+stackSizeLimitHard = zero+-- We allow a few files to be opened, such as package.conf, because they are necessary. This+-- doesn't seem to be security problem because it'll be opened at the module+-- stage, before code ever evaluates. I hope.+openFilesLimitSoft = openFilesLimitHard+openFilesLimitHard = ResourceLimit 7+-- TODO: It would be nice to set these to zero, but right now Hint gets around the+-- insecurity of the GHC API by writing stuff out to a file in /tmp, so we need+-- to allow our compiled binary to do file I/O... :( But at least we can still limit+-- how much we write out!+fileSizeLimitSoft = fileSizeLimitHard+fileSizeLimitHard = ResourceLimit 10800+dataSizeLimitSoft = dataSizeLimitHard+dataSizeLimitHard = ResourceLimit $ 6 ^ (12 :: Int)+-- These should not be identical, to give the XCPU handler time to trigger+cpuTimeLimitSoft = ResourceLimit 4+cpuTimeLimitHard = ResourceLimit 5+coreSizeLimitSoft = coreSizeLimitHard+coreSizeLimitHard = zero+-- convenience+zero = ResourceLimit 0++limits :: [(Resource, ResourceLimits)]+limits =+ [ (ResourceStackSize, ResourceLimits stackSizeLimitSoft stackSizeLimitHard)+ , (ResourceTotalMemory, ResourceLimits totalMemoryLimitSoft totalMemoryLimitHard)+ , (ResourceOpenFiles, ResourceLimits openFilesLimitSoft openFilesLimitHard)+ , (ResourceFileSize, ResourceLimits fileSizeLimitSoft fileSizeLimitHard)+ , (ResourceDataSize, ResourceLimits dataSizeLimitSoft dataSizeLimitHard)+ , (ResourceCoreFileSize, ResourceLimits coreSizeLimitSoft coreSizeLimitHard)+ , (ResourceCPUTime, ResourceLimits cpuTimeLimitSoft cpuTimeLimitHard)+ ]
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"
− tests.sh
@@ -1,121 +0,0 @@-#!/bin/sh-# tests--# Save typing-m () { echo "$@" && mueval --inferred-type --expression "$@"; }--# Test whether it's around-mueval &> /dev/null--# Abort if any commands aren't successful-set -e-# Test on valid expressions. Note we conditionalize - all of these should return successfully.-echo "Test some valid expressions \n"-## Does anything work?-m 'True'-## Test comments-m 'True -- testing'-m 'True {- Testing -}'-## OK, let's try some simple math.-m '1*100+1'-m '(1*100) +1+1' --module Control.Monad-## String processing-m "filter (\`notElem\` ['A'..'Z']) \"abcXsdzWEE\""-## see whether we gave it enough resources to do reasonably long stuff-m "(last \"nebbish\") : (head $ reverse \"fooo bar baz booooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooreally long strong, you must confess, at least relative to the usual string, I suppose\") : []"-m 'let return a k = k a ; m >>= f = m . flip f ; foldM f z [] = return z ; foldM f z (x:xs) = f z x >>= \fzx -> foldM f fzx xs ; control e k = e (\a -> const (k a)) id in foldM (\p n -> if n == 0 then control (const $ return 0) else return (p * n)) 1 [-10..] id'-# Silly "Hello World"-m 'let uncat3 [] = [] ; uncat3 xs = (let (ys, zs) = splitAt 3 xs in ys : uncat3 zs) ; getFrom x y = map (x !!) $ map (fromIntegral . ((\x -> fromIntegral $ foldl (.|.) (0::Word8) (zipWith (\c n -> if c then bit n else (0::Word8)) x [0..2])) :: [Bool] -> Int)) $ reverse . uncat3 . reverse . concat . map (((\x -> map (testBit x) [7,6..0]) :: Word8 -> [Bool]) . fromIntegral . ord) $ y in getFrom " HWdelor" "e\184-\235"'-## Single module-m '()' --module=Prelude-## Test whether we can import multiple modules-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 --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-m 'repeat 1'-## Test Unicode. If this fails, characters got mangled somewhere.-m 'let (ñ) = (+) in ñ 5 5'-## Test default imports & have some function fun-m 'fix (1:)'-m 'fix show'-m 'let fix f = let x = f x in x in fix show'-m '(+1) . (*2) $ 10'-m 'fmap fix return 42'-m 'filterM (const [False,True]) [1,2,3]'-m 'sequence [[1,2,3],[4,5]]'-m 'sort [4,6,1,2,3]'-m 'runIdentity $ mfix (return . (0:) . scanl (+) 1)'-m 'fix ((1:).(1:).(zipWith (+) `ap` tail))'-m "listArray (1,10) ['a'..]"-### Test Control.Arrow-m 'let f = (id *** id) in f (3, 4)'-### Test Control.Applicative-m "(foldr (liftA2 (||)) (const False) [isDigit, isAlpha]) '3'"-### Test SimpleReflect <http://twanvl.nl/blog/haskell/simple-reflection-of-expressions>-m "sum $ map (*x) [1..5]"-m "iterate (^2) x"-m "scanl f x [a,b,c]"-m "zipWith3 f [1,2..] [1,3..] [1,4..] :: [Expr]"-m "sum [1..5] :: Expr"-m "foldr f x [1..5]"-## Test defaulting of expressions-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' --load-file="TmpModule.hs"-m 'foo 1' --load-file="TmpModule.hs"-m "foo 1" -S --load-file="TmpModule.hs"-m 'bar 1' --load-file="TmpModule.hs"-m 'foo $ foo 1' --load-file="TmpModule.hs"-rm "TmpModule.hs"-## Test the --no-imports function-## TODO: more extensive tests of this-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-## Test Safe-Haskell-approved code-m "()" -S-m "runReader ask 42" -S --module Control.Monad.Reader-## Setup for later Safe-Haskell tests and ensure that behavior is as-## expected without SH activated-echo 'module TmpModule (unsafePerformIO) where {import System.IO.Unsafe}' > "TmpModule.hs"-m 'unsafePerformIO (readFile "/etc/passwd")' --load-file="TmpModule.hs"-## Test qualified imports-m "M.map (+1) $ M.fromList [(1,2), (3,4)]" &&-echo "\nOK, all the valid expressions worked out well." &&--# Test on bad or outright evil expressions-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' --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' ||-## test stack overflow limits-m 'let x = 1 + x in x' ||-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' ||-# 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 '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"' ||-## Evil array code, should fail (but not with a segfault!)-m "array (0::Int, maxBound) [(1000000,'x')]" --module Data.Array ||-## code that should be accepted without Safe Haskell but rejected with-m 'unsafePerformIO (readFile "/etc/passwd")' -S --load-file="TmpModule.hs" ||-echo "Done, apparently all evil expressions failed to do evil"--rm TmpModule.hs
− watchdog.hs
@@ -1,30 +0,0 @@--- | This implements a watchdog process. It calls mueval with all the--- user-specified arguments, sleeps, and then if mueval is still running--- kills it.--- Even an out-of-control mueval will have trouble avoiding 'terminateProcess'.--- Note that it's too difficult to parse the user arguments to get the timeout,--- so we specify it as a constant which is a little more generous than the default.-module Main where--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- hdl <- runProcess "mueval-core" args Nothing Nothing Nothing Nothing Nothing- _ <- forkIO $ do- threadDelay (7 * 700000)- status <- getProcessExitCode hdl- case status of - 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