diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Command/Commands.hs | 32 | ||||
| -rw-r--r-- | src/compiler/GF/Infra/UseIO.hs | 17 | ||||
| -rw-r--r-- | src/compiler/GFI.hs | 9 |
3 files changed, 38 insertions, 20 deletions
diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 1c4c1377f..bb075798c 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -45,7 +45,7 @@ import Data.Binary (encodeFile) import Data.List import Data.Maybe import qualified Data.Map as Map -import System.Cmd +--import System.Cmd(system) -- use GF.Infra.UseIO.restricedSystem instead! import Text.PrettyPrint import Data.List (sort) import Debug.Trace @@ -172,8 +172,8 @@ allCommands env@(pgf, mos) = Map.fromList [ let view = optViewGraph opts let format = optViewFormat opts writeUTF8File (file "dot") grph - system $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format - system $ view ++ " " ++ file format + restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format + restrictedSystem $ view ++ " " ++ file format return void else return $ fromString grph, examples = [ @@ -769,9 +769,9 @@ allCommands env@(pgf, mos) = Map.fromList [ exec = \opts arg -> do let tmpi = "_tmpi" --- let tmpo = "_tmpo" - writeFile tmpi $ toString arg + restricted $ writeFile tmpi $ toString arg let syst = optComm opts ++ " " ++ tmpi - system $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo + restrictedSystem $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo s <- readFile tmpo return $ fromString s, flags = [ @@ -843,9 +843,9 @@ allCommands env@(pgf, mos) = Map.fromList [ let file s = "_grphd." ++ s let view = optViewGraph opts let format = optViewFormat opts - writeUTF8File (file "dot") grphs - system $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format - system $ view ++ " " ++ file format + restricted $ writeUTF8File (file "dot") grphs + restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format + restrictedSystem $ view ++ " " ++ file format return void else return $ fromString grphs, examples = [ @@ -884,9 +884,9 @@ allCommands env@(pgf, mos) = Map.fromList [ let file s = "_grph." ++ s let view = optViewGraph opts let format = optViewFormat opts - writeUTF8File (file "dot") grph - system $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format - system $ view ++ " " ++ file format + restricted $ writeUTF8File (file "dot") grph + restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format + restrictedSystem $ view ++ " " ++ file format return void else return $ fromString grph, examples = [ @@ -929,9 +929,9 @@ allCommands env@(pgf, mos) = Map.fromList [ let file s = "_grph." ++ s let view = optViewGraph opts let format = optViewFormat opts - writeUTF8File (file "dot") grph - system $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format - system $ view ++ " " ++ file format + restricted $ writeUTF8File (file "dot") grph + restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format + restrictedSystem $ view ++ " " ++ file format return void else return $ fromString grph, examples = [ @@ -955,8 +955,8 @@ allCommands env@(pgf, mos) = Map.fromList [ exec = \opts arg -> do let file = valStrOpts "file" "_gftmp" opts if isOpt "append" opts - then appendFile file (toString arg) - else writeUTF8File file (toString arg) + then restricted $ appendFile file (toString arg) + else restricted $ writeUTF8File file (toString arg) return void, options = [ ("append","append to file, instead of overwriting it") diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs index 3940e6be1..72875f70d 100644 --- a/src/compiler/GF/Infra/UseIO.hs +++ b/src/compiler/GF/Infra/UseIO.hs @@ -26,6 +26,7 @@ import System.IO.Error import System.Environment import System.Exit import System.CPUTime +import System.Cmd import Text.Printf import Control.Monad import Control.Exception(evaluate) @@ -191,3 +192,19 @@ writeUTF8File fpath content = do hSetEncoding h utf8 hPutStr h content hClose h + +-- * Functions to limit acesss to arbitrary IO and system commands +restricted io = + either (const io) (const $ fail message) =<< try (getEnv "GF_RESTRICTED") + where + message = + "This operation is not allowed when GF is running in restricted mode." + +restrictedSystem = restricted . system + + +-- Because GHC adds the confusing text "user error" for failures cased by +-- calls to fail. +ioErrorText e = if isUserError e + then ioeGetErrorString e + else show e diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs index a7ae2d07c..1041b9c5d 100644 --- a/src/compiler/GFI.hs +++ b/src/compiler/GFI.hs @@ -36,7 +36,6 @@ import qualified Data.Map as Map import qualified Data.ByteString.Char8 as BS import qualified Text.ParserCombinators.ReadP as RP import System.IO -import System.Cmd import System.CPUTime import System.Directory import Control.Exception @@ -107,7 +106,7 @@ loop opts gfenv0 = do r <- runInterruptibly $ case pwords of "!":ws -> do - system $ unwords ws + restrictedSystem $ unwords ws loopNewCPU gfenv "cc":ws -> do let @@ -154,7 +153,7 @@ loop opts gfenv0 = do let stop = case ws of ('-':'o':'n':'l':'y':'=':fs):_ -> Just $ chunks ',' fs _ -> Nothing - writeFile "_gfdepgraph.dot" (depGraph stop sgr) + restricted $ writeFile "_gfdepgraph.dot" (depGraph stop sgr) putStrLn "wrote graph in file _gfdepgraph.dot" loopNewCPU gfenv "eh":w:_ -> do @@ -220,9 +219,11 @@ loop opts gfenv0 = do interpretCommandLine env s0 loopNewCPU gfenv -- gfenv' <- return $ either (const gfenv) id r - gfenv' <- either (\e -> (print e >> return gfenv)) return r + gfenv' <- either (\e -> (printException e >> return gfenv)) return r loop opts gfenv' +printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e) + checkComputeTerm sgr t = do mo <- maybe (Bad "no source grammar in scope") return $ greatestResource sgr ((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t |