diff --git a/Mueval/Concurrent.hs b/Mueval/Concurrent.hs --- a/Mueval/Concurrent.hs +++ b/Mueval/Concurrent.hs @@ -14,7 +14,7 @@ watchDog tout tid = do installHandler sigXCPU (CatchOnce $ throwTo tid $ ErrorCall "Time limit exceeded.") Nothing - forkIO $ do threadDelay (tout * 1000000) + forkIO $ do threadDelay (tout * 500000) -- Time's up. It's a good day to die. throwTo tid (ErrorCall "Time limit exceeded") yield -- give the other thread a chance @@ -42,9 +42,10 @@ forkIO (interpreterSession typeprint extend mdls fls expr `catchDyn` (printInterpreterError) >> putMVar mvar "Done.") - where mdls = modules opts + where mdls = if impq then Nothing else Just (modules opts) expr = expression opts tout = timeLimit opts typeprint = printType opts extend = extensions opts fls = loadFile opts + impq = noimports opts diff --git a/Mueval/Context.hs b/Mueval/Context.hs --- a/Mueval/Context.hs +++ b/Mueval/Context.hs @@ -24,18 +24,11 @@ crippled; we want SimpleReflect so we can do neat things (for said neat things, see ); - and we want ShowQ and ShowFun to neuter IO stuff even more. -} + and we want ShowQ and 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", "ShowQ", "ShowFun", "SimpleReflect"] - --- | Borrowed from Lambdabot, this is the whitelist of modules which should be --- safe to import functions from. -safeModules :: [String] -safeModules = defaultModules ++ ["Control.Applicative", - "Control.Arrow", - "Control.Arrow.Operations", - "Control.Arrow.Transformer", - "Control.Arrow.Transformer.All", +defaultModules = ["Prelude", "ShowQ", "ShowFun", "SimpleReflect", "Data.Function", "Control.Monad", "Control.Monad.Cont", "Control.Monad.Error", @@ -53,27 +46,16 @@ "Data.Array", "Data.Bits", "Data.Bool", - "Data.ByteString", - "Data.ByteString.Char8", - "Data.ByteString.Lazy", - "Data.ByteString.Lazy.Char8", "Data.Char", "Data.Complex", "Data.Dynamic", "Data.Either", "Data.Eq", "Data.Fixed", - "Data.Foldable", - "Data.Function", - "Data.Generics", - "Data.Generics", "Data.Graph", "Data.Int", - "Data.IntMap", - "Data.IntSet", "Data.Ix", "Data.List", - "Data.Map", "Data.Maybe", "Data.Monoid", "Data.Number.BigFloat", @@ -85,9 +67,6 @@ "Data.Number.Symbolic", "Data.Ord", "Data.Ratio", - "Data.Sequence", - "Data.Set", - "Data.Traversable", "Data.Tree", "Data.Tuple", "Data.Typeable", @@ -97,3 +76,32 @@ "Test.QuickCheck", "Text.PrettyPrint.HughesPJ", "Text.Printf"] + +{- | 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]" +-} +safeModules :: [String] +safeModules = defaultModules ++ ["Control.Applicative", + "Control.Arrow", + "Control.Arrow.Operations", + "Control.Arrow.Transformer", + "Control.Arrow.Transformer.All", + "Data.ByteString", + "Data.ByteString.Char8", + "Data.ByteString.Lazy", + "Data.ByteString.Lazy.Char8", + "Data.Foldable", + "Data.Generics", + "Data.IntMap", + "Data.IntSet", + "Data.Map", + "Data.Sequence", + "Data.Set", + "Data.Traversable"] diff --git a/Mueval/Interpreter.hs b/Mueval/Interpreter.hs --- a/Mueval/Interpreter.hs +++ b/Mueval/Interpreter.hs @@ -34,7 +34,7 @@ optimizations, hide all packages, make sure one cannot call unimported functions, typecheck (and optionally print it), set resource limits for this thread, and do some error handling. -} -interpreter :: Bool -> Bool -> [ModuleName] -> String -> String -> Interpreter () +interpreter :: Bool -> Bool -> Maybe [ModuleName] -> String -> String -> Interpreter () interpreter prt exts modules lfl expr = do setUseLanguageExtensions exts -- False by default @@ -45,7 +45,8 @@ reset -- Make sure nothing is available setInstalledModsAreInScopeQualified False - let doload = if lfl == "" then False else True + let doload = if lfl == "" + then False else True when doload (liftIO $ mvload lfl) @@ -59,7 +60,9 @@ -- module setTopLevelModules [(takeWhile (/='.') lfl')] - setImports modules + case modules of + Nothing -> return () + Just ms -> setImports ms when prt (say $ expr ++ "\n") @@ -70,14 +73,14 @@ say "\n" else return () result <- eval expr - say $ show result ++ "\n" + say $ result ++ "\n" else error "Expression did not type check." -- | Wrapper around 'interpreter'; supplies a fresh GHC API session and -- error-handling. The arguments are simply passed on. interpreterSession :: Bool -- ^ Whether to print inferred type -> Bool -- ^ Whether to use GHC extensions - -> [ModuleName] -- ^ A list of modules we wish to be visible + -> Maybe [ModuleName] -- ^ A list of modules we wish to be visible -> String -- ^ A local file from which to grab definitions; an -- empty string is treated as no file. -> String -- ^ The string to be interpreted as a Haskell expression diff --git a/Mueval/ParseArgs.hs b/Mueval/ParseArgs.hs --- a/Mueval/ParseArgs.hs +++ b/Mueval/ParseArgs.hs @@ -17,6 +17,7 @@ , user :: String , printType :: Bool , extensions :: Bool + , noimports :: Bool } deriving Show defaultOptions :: Options @@ -26,7 +27,8 @@ , user = "" , loadFile = "" , printType = False - , extensions = False } + , extensions = False + , noimports = False } options :: [OptDescr (Options -> Options)] options = [Option ['p'] ["password"] @@ -43,6 +45,9 @@ Option ['m'] ["module"] (ReqArg (\m opts -> opts { modules = m:(modules opts) }) "MODULE") "A module we should import functions from for evaluation. (Can be given multiple times.)", + Option ['n'] ["noimports"] + (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.", 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.", diff --git a/mueval.cabal b/mueval.cabal --- a/mueval.cabal +++ b/mueval.cabal @@ -1,5 +1,5 @@ name: mueval -version: 0.6.1 +version: 0.6.2 license: BSD3 license-file: LICENSE @@ -32,9 +32,9 @@ exposed-modules: Mueval.Concurrent, Mueval.Context, Mueval.Interpreter, Mueval.ParseArgs, Mueval.Resources build-depends: base, directory, mtl, filepath, unix, hint>=0.2.4, show>=0.3, utf8-string - ghc-options: -Wall -static + ghc-options: -Wall -static -O2 executable mueval main-is: main.hs build-depends: base - ghc-options: -Wall -threaded -static + ghc-options: -Wall -static -O2 diff --git a/tests.sh b/tests.sh --- a/tests.sh +++ b/tests.sh @@ -9,7 +9,7 @@ # Test on valid expressions. Note we conditionalize - all of these should return successfully. echo "Test some valid expressions \n" ## Does anything work? -m 'False' +m 'True' ## OK, let's try some simple math. m '1*100+1' m '(1*100) +1+1' --module Control.Monad @@ -37,6 +37,20 @@ m 'mysmallcheck (\x -> not x || x)' -E ## 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 'runST (return 0)' +## Test defaulting of expressions +m 'show []' -E ## Now let's do file loading echo "module TmpModule (foo, bar) where\nfoo x = x + 1 \nbar x = x + 2" > "TmpModule.hs" m '1+1' --loadfile="TmpModule.hs" @@ -44,6 +58,9 @@ m 'bar 1' --loadfile="TmpModule.hs" m 'foo $ foo 1' --loadfile="TmpModule.hs" rm "TmpModule.hs" +## Test the --noimports function +## TODO: more extensive tests of this +m '()' --noimports echo "\nOK, all the valid expressions worked out well." && # Test on bad or outright evil expressions @@ -54,14 +71,16 @@ 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 limits +## 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' || ## Now let's test the module whitelisting m 1+1 --module Data.List --module System.IO.Unsafe --module Control.Monad || m "let foo = unsafePerformIO readFile \"/etc/passwd\" in foo" --module System.IO.Unsafe || m "head [1..]" --module Data.List --module Text.HTML.Download || +m " runST (unsafeIOToST (readFile \"/etc/passwd\"))" || ### Can we bypass the whitelisting by fully qualified module names? m "Foreign.unsafePerformIO $ readFile \"/etc/passwd\"" || m "Data.ByteString.Internal.inlinePerformIO $ readFile \"/etc/passwd\"" ||