mueval-0.9.1.1.2/0000755000000000000000000000000012545643774011520 5ustar0000000000000000mueval-0.9.1.1.2/LICENSE0000644000000000000000000000261612545643774012532 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.1.2/Setup.hs0000644000000000000000000000013712545643774013155 0ustar0000000000000000#!/usr/bin/runhaskell import Distribution.Simple main = defaultMainWithHooks simpleUserHooks mueval-0.9.1.1.2/HCAR.tex0000644000000000000000000000352612545643774012765 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.1.2/main.hs0000644000000000000000000000114412545643774013000 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.1.2/tests.sh0000755000000000000000000001342612545643774013227 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 '(+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.1.2/README.md0000644000000000000000000001222712545643774013003 0ustar0000000000000000# What Mueval grew out of my discontent with Lambdabot: it's really neat to be able to run expressions in `#haskell` 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: $ mueval --expression '1*100+1' Expression type: (Num t) => t result: "101" $ 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: $ mueval --expression 'let x = x in x' Expression type: t result: "mueval: Time limit exceeded" $ mueval --expression "let foo = readFile \"/etc/passwd\" >>= print in foo" Expression type: IO () result: "" $ mueval --module System.IO.Unsafe --expression "let foo = unsafePerformIO readFile \"/etc/passwd\" in foo" mueval: Unknown or untrusted module supplied! Aborting. ## Loading definitions from files 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 Hackage: . Mueval has a public Git repository, at . Contributions & updates 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: $ cabal install mueval However, you can still manually download and unpack the Mueval tarball, and do the usual Cabal dance: $ runhaskell Setup configure $ runhaskell Setup build $ runhaskell Setup install # See also - Chris Done's interactive Haskell REPL website, [Try Haskell!](http://tryhaskell.org/) # 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 cannot do qualified imports. This is due to limitations in the GHC API; see & . As of 2010 or so, compiling Mueval (or any Hint-using executable) with profiling support seems to lead to runtime crashes. Finally, under GHC 6.10.1 (and higher?), 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`.) # Contributions 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 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. Also good is making sure `cabal check` and `hlint` are happy; but that's not as important as `tests.sh` passing. # License BSD-3. mueval-0.9.1.1.2/watchdog.hs0000644000000000000000000000314112545643774013653 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.1.2/build.sh0000755000000000000000000000100512545643774013152 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.1.2/mueval.cabal0000644000000000000000000000403612545643774014000 0ustar0000000000000000name: mueval version: 0.9.1.1.2 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: https://github.com/gwern/mueval build-type: Simple cabal-version: >= 1.6 tested-with: GHC==6.10.1 data-files: README.md, 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, Cabal, extensible-exceptions, simple-reflect, QuickCheck ghc-options: -Wall -static executable mueval-core main-is: main.hs build-depends: base ghc-options: -Wall -static -threaded executable mueval main-is: watchdog.hs build-depends: base ghc-options: -Wall -static -threaded source-repository head type: git location: git://github.com/gwern/mueval.git mueval-0.9.1.1.2/Mueval/0000755000000000000000000000000012545643774012751 5ustar0000000000000000mueval-0.9.1.1.2/Mueval/Parallel.hs0000644000000000000000000000507712545643774015052 0ustar0000000000000000module 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 xmueval-0.9.1.1.2/Mueval/Resources.hs0000644000000000000000000000532112545643774015260 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.1.2/Mueval/Interpreter.hs0000644000000000000000000002152712545643774015617 0ustar0000000000000000{-# 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, 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, 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 ":" 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) mueval-0.9.1.1.2/Mueval/ArgsParse.hs0000644000000000000000000001261712545643774015203 0ustar0000000000000000{-# LANGUAGE CPP #-} module Mueval.ArgsParse (Options(..), interpreterOpts, getOptions) 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..." -- | 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 decodeString decodeString :: String -> String #if __GLASGOW_HASKELL__ >= 702 decodeString = id #else decodeString = Codec.decodeString #endif mueval-0.9.1.1.2/Mueval/Context.hs0000644000000000000000000001064412545643774014736 0ustar0000000000000000{-# 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 ); 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") ]