From 2c1feccd1736c5535251bc5a7f484b5f2c35b9fc Mon Sep 17 00:00:00 2001 From: hallgren Date: Thu, 3 Mar 2011 15:42:57 +0000 Subject: [PATCH] GF shell restricted mode By setting the environment variable GF_RESTRICTED before starting GF, the shell will be run in restricted mode. This will prevent the GF shell from starting arbitrary system commands (most uses of System.Cmd.system are blocked) and writing arbitrary files (most commands that use writeFile et al are blocked). Restricted mode is intended minimize the potential security risks involved in allowing public access to the GF shell over the internet. It should be used in conjuction with system level protection mechanisms (e.g. file permissions) to make sure that a publicly acessible GF shell does not give access to parts of the system that should not be publicly accessible. --- src/compiler/GF/Command/Commands.hs | 32 ++++++++++++++--------------- src/compiler/GF/Infra/UseIO.hs | 17 +++++++++++++++ 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