mueval-0.9.1/0000755000000000000000000000000012203735610011177 5ustar0000000000000000mueval-0.9.1/tests.sh0000755000000000000000000001344712203735610012711 0ustar0000000000000000#!/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 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 'show []' -E 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 mueval-0.9.1/main.hs0000644000000000000000000000114412203735610012457 0ustar0000000000000000-- TODO: -- Need to add user switching. Perhaps using seteuid and setegid? See -- & -- module Main (main) where 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 case getOptions args of Left (n,s) -> putStrLn s >> if n then exitSuccess else exitFailure Right opts -> forkedMain $! opts mueval-0.9.1/LICENSE0000644000000000000000000000261612203735610012211 0ustar0000000000000000All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. mueval-0.9.1/README0000644000000000000000000001227512203735610012066 0ustar0000000000000000WHAT: Mueval grew out of my discontent with Lambdabot: it's really neat to be able to run expressions like this: 07:53 < ivanm> > filter (\ x -> isLetter x || x == '\t') "asdf$#$ dfs" 07:55 < lambdabot> "asdfdfs" But Lambdabot is crufty and very difficult to install or run. IMO, we need a replacement or rewrite, but one of the things that make this difficult is that Lambdabot uses hs-plugins to get that sort of evaluation functionality, and hs-plugins is half the problem. We want some sort of standalone executable which provides that functionality. Now, 'ghc -e' is obviously unsuited because there is no sandboxing, so what I've done is basically marry the GHC API (as rendered less sharp-edged by Hint) with a bunch of resource limits and sandboxing (as largely stolen from Lambdabot). EXAMPLES: The end result is an adorable little program, which you can use like this: bash-3.2$ mueval --expression '1*100+1' Expression type: (Num t) => t result: "101" bash-3.2$ mueval --expression "filter (\`notElem\` ['A'..'Z']) \"abcXsdzWEE\"" Expression type: [Char] result: "\"abcsdz\"" Note that mueval will avoid all the attacks I've been able to test on it: bash-3.2$ mueval --expression 'let x = x in x' Expression type: t result: "mueval: Time limit exceeded bash-3.2$ mueval --expression "let foo = readFile \"/etc/passwd\" >>= print in foo" Expression type: IO () result: "" bash-3.2$ mueval --module System.IO.Unsafe --expression "let foo = unsafePerformIO readFile \"/etc/passwd\" in foo" mueval: Unknown or untrusted module supplied! Aborting. 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'. (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. GETTING: You can download Mueval at the usual place: . Mueval has a public darcs repository, at (in the mueval/ subdirectory). Contributions are of course welcomed. INSTALLING: Mueval depends on a few of the standard libraries, which you should have installed already, and also on the 'Hint' library ; Hint is particularly essential as it is the very capable wrapper around the GHC API which Mueval uses. (Without Hint, this would've been much more painful to write). All of this is cabalized, so ideally installation will be as simple as: sh$ cabal install mueval However, you can still manually download and unpack the Mueval tarball, and do the usual Cabal dance: sh$ runhaskell Setup configure sh$ runhaskell Setup build sh$ runhaskell Setup install BUGS: Mueval uses a number of techniques for security; particularly problematic seem to be the resource limits, as they have to be specified manually & statically in the source code and so will probably be broken somewhere somewhen. For this reason, they are not enabled by default. Experiment with --rlimits for hours of fun! Mueval also simply cannot do qualified imports. This is due to limitations in the GHC API; see . (Remember that CC'ing yourself is an implicit vote for the problem to be fixed!) With darcs Hint and Mueval, compiling Mueval (or any Hint-using executable) with profiling support seems to lead to runtime crashes. Finally, under 6.10.1, you must run Mueval with "+RTS -N2 -RTS" as otherwise the watchdog threads will not get run and DoS attacks are possible. (Compare 'mueval -e "let x = x + 1 in x"' against 'mueval -e "let x = x + 1 in x" +RTS -N2 -RTS'.) CONTRIBUTING: So, you've discovered a bug or other infelicity? If you can successfully build & install Mueval, but running it on expressions leads to errors, please send me an email at . Include in the email all the output you see if you run the informal test suite: sh$ sh tests.sh If this script *does not* terminate with a success message, then there's probably something wrong. One of the properties Mueval strives to have is that on every bad expression, it errors out with an exit code of 1, and on every good expression, an exit code of 0. If you have a patch handy, 'darcs send' is the best way to contribute. As above, tests.sh should be happy, as should 'cabal check'; even better is if your email is GPG-signed, but that's not as important as test.sh passing. mueval-0.9.1/mueval.cabal0000644000000000000000000000400612203735610013454 0ustar0000000000000000name: mueval version: 0.9.1 license: BSD3 license-file: LICENSE author: Gwern maintainer: Gwern 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: http://code.haskell.org/mubot/ build-type: Simple cabal-version: >= 1.6 tested-with: GHC==6.10.1 data-files: README, HCAR.tex extra-source-files: build.sh, tests.sh library exposed-modules: Mueval.Parallel, Mueval.Context, Mueval.Interpreter, Mueval.ArgsParse, Mueval.Resources build-depends: base>=4 && < 5, containers, directory, mtl>2, filepath, unix, process, hint>=0.3.1, show>=0.3, utf8-string, Cabal, extensible-exceptions, simple-reflect ghc-options: -Wall -static -O2 executable mueval-core main-is: main.hs build-depends: base ghc-options: -Wall -static -threaded -O2 executable mueval main-is: watchdog.hs build-depends: base ghc-options: -Wall -static -threaded -O2 source-repository head type: darcs location: http://code.haskell.org/mubot/ mueval-0.9.1/watchdog.hs0000644000000000000000000000314112203735610013332 0ustar0000000000000000-- | 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 mueval-0.9.1/HCAR.tex0000644000000000000000000000352612203735610012444 0ustar0000000000000000% mueval-Gm.tex \begin{hcarentry}{mueval} \label{mueval} \report{Gwern Branwen}%05/10 \participants{Andrea Vezzosi, Daniel Gorin, Spencer Janssen, Adam Vogt} \status{active development} \makeheader See: \url{http://www.haskell.org/communities/05-2010/html/report.html#sect5.3.3}. % 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} % \item A comprehensive test-suite of expressions which should and should not work % \item Defeats all known attacks % \item Optional resource limits and module imports % \item The ability to load in definitions from a specified file % \item Parses Haskell expressions with haskell-src-exts and tests against black- and white-lists % \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 % The source repository is available: % \texttt{darcs get} % \text{\url{http://code.haskell.org/mubot/}} \end{hcarentry} mueval-0.9.1/Setup.hs0000644000000000000000000000013712203735610012634 0ustar0000000000000000#!/usr/bin/runhaskell import Distribution.Simple main = defaultMainWithHooks simpleUserHooks mueval-0.9.1/build.sh0000755000000000000000000000100512203735610012631 0ustar0000000000000000#!/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!" mueval-0.9.1/Mueval/0000755000000000000000000000000012203735610012430 5ustar0000000000000000mueval-0.9.1/Mueval/Parallel.hs0000644000000000000000000000505112203735610014521 0ustar0000000000000000module Mueval.Parallel where import Control.Concurrent (forkIO, killThread, myThreadId, threadDelay, throwTo, ThreadId) import System.Posix.Signals (sigXCPU, installHandler, Handler(CatchOnce)) import Control.Exception.Extensible as E (ErrorCall(..),SomeException,catch) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, MVar) import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering)) 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 = block forkedMain' opts >> return () -- | 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 xmueval-0.9.1/Mueval/Resources.hs0000644000000000000000000000532112203735610014737 0ustar0000000000000000module 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)] mueval-0.9.1/Mueval/Context.hs0000644000000000000000000001042512203735610014412 0ustar0000000000000000module 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 ); 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", "Control.Monad.Error", "Control.Monad.Fix", "Control.Monad.Identity", "Control.Monad.Instances", "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-0.9.1/Mueval/ArgsParse.hs0000644000000000000000000001204412203735610014654 0ustar0000000000000000module Mueval.ArgsParse (Options(..), interpreterOpts, getOptions) where import Control.Monad (liftM) import System.Console.GetOpt import qualified Codec.Binary.UTF8.String as Codec (decodeString) 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 , 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 , 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 "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..." -- | Just give us the end result options; this parsing for -- us. Bonus points for handling UTF. getOptions :: [String] -> Either (Bool, String) Options getOptions = interpreterOpts . map Codec.decodeStringmueval-0.9.1/Mueval/Interpreter.hs0000644000000000000000000001723212203735610015274 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} -- TODO: suggest the convenience functions be put into Hint proper? module Mueval.Interpreter where import Control.Monad (guard,mplus,unless,when) import Control.Monad.Trans (MonadIO) import Control.Monad.Writer (Any(..),runWriterT,tell) import Data.Char (isDigit) import Data.List (stripPrefix) 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(..)) import qualified System.IO.UTF8 as UTF (putStrLn) import Language.Haskell.Interpreter (eval, set, reset, setImportsQ, loadModules, liftIO, installedModulesInScope, languageExtensions, typeOf, setTopLevelModules, runInterpreter, glasgowExtensions, 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, 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" flip mapM_ (trustPkgs >>= words) $ \pkg -> unsafeSetGhcOption ("-trust " ++ pkg) reset -- Make sure nothing is available set [installedModulesInScope := False] let lfl' = takeFileName load when (load /= "") $ do liftIO (mvload load) loadModules [lfl'] -- We need to mangle the String to -- turn a filename into a module. setTopLevelModules [takeWhile (/='.') lfl'] 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 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 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 setCurrentDirectory "/tmp" -- will at least mess up relative links --------------------------------- -- 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 UTF.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 ":" 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)