diff --git a/Mueval/Concurrent.hs b/Mueval/Concurrent.hs --- a/Mueval/Concurrent.hs +++ b/Mueval/Concurrent.hs @@ -39,7 +39,7 @@ hSetBuffering stdout NoBuffering -- Our modules and expression are set up. Let's do stuff. - forkIO (interpreterSession typeprint extend mdls expr + forkIO (interpreterSession typeprint extend mdls fls expr `catchDyn` (printInterpreterError) >> putMVar mvar "Done.") where mdls = modules opts @@ -47,3 +47,4 @@ tout = timeLimit opts typeprint = printType opts extend = extensions opts + fls = loadFile opts diff --git a/Mueval/Interpreter.hs b/Mueval/Interpreter.hs --- a/Mueval/Interpreter.hs +++ b/Mueval/Interpreter.hs @@ -1,14 +1,17 @@ -- TODO: suggest the convenience functions be put into Hint proper? module Mueval.Interpreter where -import Control.Monad.Trans (liftIO) +import Control.Monad (when) import qualified Control.Exception (catch) +import Control.Monad.Trans (liftIO) +import System.Directory (copyFile, makeRelativeToCurrentDirectory, removeFile) -import Language.Haskell.Interpreter.GHC (eval, newSession, reset, setImports, +import Language.Haskell.Interpreter.GHC (eval, newSession, reset, setImports, loadModules, setOptimizations, setUseLanguageExtensions, setInstalledModsAreInScopeQualified, - typeChecks, typeOf, withSession, + typeChecks, typeOf, withSession, setTopLevelModules, Interpreter, InterpreterError, ModuleName, Optimizations(All)) + import qualified Codec.Binary.UTF8.String as Codec (decodeString) import qualified System.IO.UTF8 as UTF (putStr) @@ -30,8 +33,8 @@ 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 -> Interpreter () -interpreter prt exts modules expr = do +interpreter :: Bool -> Bool -> [ModuleName] -> String -> String -> Interpreter () +interpreter prt exts modules lfl expr = do setUseLanguageExtensions exts -- False by default setOptimizations All -- Maybe optimization will make @@ -41,11 +44,22 @@ reset -- Make sure nothing is available setInstalledModsAreInScopeQualified False - setImports modules - if prt then say $ expr ++ "\n" else return () + let doload = if lfl == "" then False else True + when doload (liftIO $ mvload lfl) + liftIO Mueval.Resources.limitResources + when doload $ do loadModules [lfl] + -- We need to mangle the String to + -- turn a filename into a + -- module + setTopLevelModules [(takeWhile (/='.') lfl)] + + setImports modules + + when prt (say $ expr ++ "\n") + checks <- typeChecks expr if checks then do @@ -61,9 +75,18 @@ interpreterSession :: Bool -- ^ Whether to print inferred type -> Bool -- ^ Whether to use GHC extensions -> [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 -> IO () -- ^ No real result, since printing is done deeper in -- the stack. -interpreterSession prt exts mds expr = Control.Exception.catch - (newSession >>= (flip withSession) (interpreter prt exts mds expr)) - (\_ -> error "Expression did not compile.") +interpreterSession prt exts mds lfl expr = Control.Exception.catch + (newSession >>= (flip withSession) (interpreter prt exts mds lfl expr)) + (\_ -> do case lfl of + "" -> return () + l -> removeFile l + error "Expression did not compile.") + +mvload :: FilePath -> IO () +mvload lfl = do canonfile <- (makeRelativeToCurrentDirectory lfl) + liftIO $ copyFile canonfile ("/tmp/" ++ canonfile) diff --git a/Mueval/ParseArgs.hs b/Mueval/ParseArgs.hs --- a/Mueval/ParseArgs.hs +++ b/Mueval/ParseArgs.hs @@ -13,6 +13,7 @@ { timeLimit :: Int , modules :: [String] , expression :: String + , loadFile :: String , user :: String , printType :: Bool , extensions :: Bool @@ -23,6 +24,7 @@ , modules = defaultModules , timeLimit = 5 , user = "" + , loadFile = "" , printType = False , extensions = False } @@ -33,6 +35,11 @@ Option ['t'] ["timelimit"] (ReqArg (\t opts -> opts { timeLimit = (read t :: Int) }) "TIME") "Time limit for compilation and evaluation", + + Option ['l'] ["loadfile"] + (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 = m:(modules opts) }) "MODULE") "A module we should import functions from for evaluation. (Can be given multiple times.)", diff --git a/Mueval/Resources.hs b/Mueval/Resources.hs --- a/Mueval/Resources.hs +++ b/Mueval/Resources.hs @@ -13,25 +13,25 @@ -- | Set all the available rlimits. -- These values have been determined through trial-and-error -totalMemoryLimitSoft, totalMemoryLimitHard, stackSizeLimitSoft, stackSizeLimitHard, - openFilesLimitSoft, openFilesLimitHard, fileSizeLimitSoft, fileSizeLimitHard, dataSizeLimitSoft, +stackSizeLimitSoft, stackSizeLimitHard, + dataSizeLimitSoft, dataSizeLimitHard, cpuTimeLimitSoft, cpuTimeLimitHard, coreSizeLimitSoft, coreSizeLimitHard, zero :: ResourceLimit -totalMemoryLimitSoft = dataSizeLimitSoft -totalMemoryLimitHard = dataSizeLimitHard +-- 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 +-- 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 590 +-- fileSizeLimitSoft = fileSizeLimitHard +-- fileSizeLimitHard = ResourceLimit 590 dataSizeLimitSoft = dataSizeLimitHard dataSizeLimitHard = ResourceLimit $ 6^(12::Int) -- These should not be identical, to give the XCPU handler time to trigger @@ -43,9 +43,9 @@ limits :: [(Resource, ResourceLimits)] limits = [ (ResourceStackSize, ResourceLimits stackSizeLimitSoft stackSizeLimitHard) - , (ResourceTotalMemory, ResourceLimits totalMemoryLimitSoft totalMemoryLimitHard) - , (ResourceOpenFiles, ResourceLimits openFilesLimitSoft openFilesLimitHard) - , (ResourceFileSize, ResourceLimits fileSizeLimitSoft fileSizeLimitHard) +-- , (ResourceTotalMemory, ResourceLimits totalMemoryLimitSoft totalMemoryLimitHard) +-- , (ResourceOpenFiles, ResourceLimits openFilesLimitSoft openFilesLimitHard) +-- , (ResourceFileSize, ResourceLimits fileSizeLimitSoft fileSizeLimitHard) , (ResourceDataSize, ResourceLimits dataSizeLimitSoft dataSizeLimitHard) , (ResourceCoreFileSize, ResourceLimits coreSizeLimitSoft coreSizeLimitHard) , (ResourceCPUTime, ResourceLimits cpuTimeLimitSoft cpuTimeLimitHard)] diff --git a/README b/README --- a/README +++ b/README @@ -30,6 +30,11 @@ 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'. + SUMMARY: Anyway, it's my hope that this will be useful as an example or useful in itself for people endeavouring to fix the Lambdabot situation or just in safely running code period. diff --git a/mueval.cabal b/mueval.cabal --- a/mueval.cabal +++ b/mueval.cabal @@ -1,5 +1,5 @@ name: mueval -version: 0.5.1 +version: 0.6 license: BSD3 license-file: LICENSE diff --git a/tests.sh b/tests.sh --- a/tests.sh +++ b/tests.sh @@ -37,6 +37,13 @@ m 'mysmallcheck (\x -> not x || x)' -E ## Test Unicode. If this fails, characters got mangled somewhere. m 'let (ñ) = (+) in ñ 5 5' +## 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" +m 'foo 1' --loadfile="TmpModule.hs" +m 'bar 1' --loadfile="TmpModule.hs" +m 'foo $ foo 1' --loadfile="TmpModule.hs" +rm "TmpModule.hs" echo "\nOK, all the valid expressions worked out well." && # Test on bad or outright evil expressions