├── .gitignore ├── Setup.hs ├── README.md ├── Hails ├── CJail │ ├── Types.hs │ ├── System │ │ ├── Process.hs │ │ └── Process │ │ │ └── TCB.hs │ └── Types │ │ └── TCB.hs └── CJail.hs ├── LICENSE └── hails-cjail.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main :: IO () 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | hails-cjail 2 | =========== 3 | 4 | This library provides a Haskell LIO monad transformer for executing 5 | cjailed processes. To use this library you must first install `cjail` 6 | from: 7 | 8 | git clone http://www.github.com/scslab/cjail.git 9 | -------------------------------------------------------------------------------- /Hails/CJail/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | #if __GLASGOW_HASKELL__ >= 702 3 | {-# LANGUAGE Trustworthy #-} 4 | #endif 5 | -- | Safe interface to "Hails.CJail.Types.TCB". 6 | module Hails.CJail.Types ( -- * CJail monad 7 | CJailConf, cjUser, cjTimeout, cjDir 8 | , CJail, runCJail 9 | , getCJailConf 10 | ) where 11 | import Hails.CJail.Types.TCB 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This program is free software; you can redistribute it and/or 2 | modify it under the terms of the GNU General Public License as 3 | published by the Free Software Foundation; either version 2, or (at 4 | your option) any later version. 5 | 6 | This program is distributed in the hope that it will be useful, but 7 | WITHOUT ANY WARRANTY; without even the implied warranty of 8 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 9 | General Public License for more details. 10 | 11 | You can obtain copies of permitted licenses from these URLs: 12 | 13 | http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt 14 | http://www.gnu.org/licenses/gpl-3.0.txt 15 | 16 | or by writing to the Free Software Foundation, Inc., 59 Temple Place, 17 | Suite 330, Boston, MA 02111-1307 USA 18 | -------------------------------------------------------------------------------- /Hails/CJail/System/Process.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | #if __GLASGOW_HASKELL__ >= 702 3 | {-# LANGUAGE Trustworthy #-} 4 | #endif 5 | -- | Safe interface to "Hails.CJail.System.Process.TCB". 6 | module Hails.CJail.System.Process ( -- * Running sub-processes 7 | createProcess 8 | , shell, proc 9 | , CreateProcess(..) 10 | , CmdSpec(..) 11 | , ProcessHandle 12 | , LProcessHandle 13 | , stdIn, stdOut, stdErr, processHandle 14 | -- ** Specific variants of createProcess 15 | , readProcess 16 | , readProcessWithExitCode 17 | -- * Process completion 18 | , waitForProcess, waitForProcessP 19 | , getProcessExitCode, getProcessExitCodeP 20 | , terminateProcess, terminateProcessP 21 | , closeHandles, closeHandlesP 22 | ) where 23 | 24 | import Hails.CJail.System.Process.TCB 25 | -------------------------------------------------------------------------------- /hails-cjail.cabal: -------------------------------------------------------------------------------- 1 | Name: hails-cjail 2 | Version: 0.1 3 | build-type: Simple 4 | License: GPL-2 5 | License-File: LICENSE 6 | Author: HAILS team 7 | Maintainer: Deian Stefan 8 | Stability: experimental 9 | Synopsis: Bindings for the Arch linux cjail 10 | Category: Security 11 | Cabal-Version: >= 1.6 12 | 13 | Description: 14 | This library provides a process-like inteface for executing 15 | arbitrary code in a jail (using the cjail program) using an 16 | LIO monad transformer. 17 | 18 | Currently only Arch linux is supported. You should install 19 | cjail from: 20 | 21 | git clone 22 | 23 | 24 | Source-repository head 25 | Type: git 26 | Location: http://www.github.com/scslab/hails-cjail.git 27 | 28 | Library 29 | Build-Depends: base >= 4.5 && < 5, 30 | containers >= 0.4.2 && < 0.5, 31 | bytestring >= 0.9 && < 1, 32 | mtl >= 1.1.0.2 && < 3, 33 | process >= 1.1.0.1 && < 1.2, 34 | lio >= 0.1.4 && < 0.2 35 | 36 | ghc-options: -Wall -Werror -fno-warn-orphans 37 | 38 | Exposed-modules: 39 | Hails.CJail 40 | Hails.CJail.Types 41 | Hails.CJail.System.Process 42 | Hails.CJail.Types.TCB 43 | Hails.CJail.System.Process.TCB 44 | -------------------------------------------------------------------------------- /Hails/CJail.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | #if __GLASGOW_HASKELL__ >= 702 3 | {-# LANGUAGE Trustworthy #-} 4 | #endif 5 | {-| 6 | This module rexports an interface for executing arbitrary code in a 7 | jailed environment provided by @cjail@ in the 'CJail' monad. The 8 | interface for executing arbitrary jailed processes is like that of 9 | "System.Process". See the exported modules for further documentation. 10 | 11 | Utnrusted code cannot construct arbitrary CJail environment 12 | configurations (i.e., values of type CJailConf). Instead, trusted code 13 | must create such a value or 'inCJail' must be used. In the latter case 14 | the environment is read for variables: 15 | 16 | * @HAILS_CJAIL_TIMEOUT@ corresponds to the @--timeout@ option. 17 | 18 | * @HAILS_CJAIL_DIR@ corresponds to the @cjail@ jail. 19 | 20 | The @HAILS_CJAIL_DIR@ variable must be defined, otherwise 'inJail' 21 | throws an exception. 22 | 23 | -} 24 | module Hails.CJail ( inCJail 25 | , module Hails.CJail.Types 26 | , module Hails.CJail.System.Process 27 | ) where 28 | 29 | import Hails.CJail.Types 30 | import Hails.CJail.System.Process 31 | 32 | import Hails.CJail.Types.TCB (CJailConf(..)) 33 | 34 | import Data.Maybe (listToMaybe) 35 | 36 | import LIO.TCB 37 | import System.Environment 38 | 39 | -- | Execute a jailed process in a cjail defined according to the 40 | -- environment. 41 | inCJail :: LabelState l p s => CJail l p s a -> LIO l p s a 42 | inCJail io = do 43 | e <- rtioTCB getEnvironment 44 | case lookup "HAILS_CJAIL_DIR" e of 45 | Nothing -> throwIO . userError $ "Jailed processes not supported" 46 | Just dir -> runCJail CJailConf { cjUser = Nothing 47 | , cjTimeout = toutFromEnv 48 | , cjDir = dir } io 49 | where toutFromEnv = do tS <- lookup "HAILS_CJAIL_TIMEOUT" e 50 | maybeRead tS 51 | maybeRead :: Read a => String -> Maybe a 52 | maybeRead = fmap fst . listToMaybe . reads 53 | -------------------------------------------------------------------------------- /Hails/CJail/Types/TCB.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | #if __GLASGOW_HASKELL__ >= 704 3 | {-# LANGUAGE Unsafe #-} 4 | #endif 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE FlexibleInstances #-} 7 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 8 | {-# LANGUAGE DeriveFunctor #-} 9 | -- | This module export a 'CJail' monad which is a wrapper for 'LIO' 10 | -- carrying a trusted configuration state. In fact 'CJail' is a Reader 11 | -- monad that is not explicily an instance of 'MonadReader'. Jailed 12 | -- computations should be executed within this monad. The jail 13 | -- configuration 'CJailConf' Show instance returns the string command 14 | -- to @cjail@. 15 | module Hails.CJail.Types.TCB ( -- * CJail monad 16 | CJailConf(..) 17 | , CJail(..) 18 | , getCJailConf 19 | , runCJail 20 | , confToCmdArgs 21 | ) where 22 | 23 | import LIO 24 | import Control.Monad.Reader 25 | 26 | 27 | -- | A cjail configuration 28 | data CJailConf = CJailConf { cjUser :: Maybe String 29 | -- ^ User 30 | , cjTimeout :: Maybe Int 31 | -- ^ Timeout in seconds 32 | , cjDir :: FilePath 33 | -- ^ Path to jail 34 | } 35 | 36 | instance Show CJailConf where 37 | show conf = unwords 38 | [ "cjail" 39 | , maybe "" ("--user "++) (cjUser conf) 40 | , maybe "" (("--timeout "++) . show) (cjTimeout conf) 41 | , cjDir conf 42 | , "" ] 43 | 44 | -- | CJailed monad is LIO + cjail state 45 | newtype CJail l p s a = CJail { unCJail :: ReaderT CJailConf (LIO l p s) a } 46 | deriving (Functor, Monad) 47 | 48 | instance LabelState l p s => MonadLIO (CJail l p s) l p s where 49 | liftLIO = CJail . liftLIO 50 | 51 | -- | Get current configuration 52 | getCJailConf :: CJail l p s CJailConf 53 | getCJailConf = CJail ask 54 | 55 | -- | Execute a CJail computation 56 | runCJail :: LabelState l p s => CJailConf -> CJail l p s a -> LIO l p s a 57 | runCJail conf m = runReaderT (unCJail m) conf 58 | 59 | -- | Convertconfiguration to pair of command and arguments. 60 | confToCmdArgs :: CJailConf -> (String, [String]) 61 | confToCmdArgs conf = ("cjail", u ++ t ++ ["--", cjDir conf]) 62 | where u = maybe [] (\x -> ["--user",x]) $ cjUser conf 63 | t = maybe [] (\x -> ["--timeout", show x ]) $ cjTimeout conf 64 | -------------------------------------------------------------------------------- /Hails/CJail/System/Process/TCB.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | #if __GLASGOW_HASKELL__ >= 704 3 | {-# LANGUAGE Unsafe #-} 4 | #endif 5 | {- | This module exports an interface that is similar to 6 | "System.Process", but uses labeled handles and labeled process 7 | handles to communicate with a process. 8 | 9 | The semantcs are different from "System.Process" in several ways: 10 | 11 | * All the commands and executables are withing a @cjail@ and 12 | so peristance staorage lasts only for the duration of a 'runCJail'. 13 | 14 | * Neither the environment nor file handles of the current process 15 | are in herited. New file handles are always created, and the 16 | environment is by default empty. 17 | 18 | -} 19 | module Hails.CJail.System.Process.TCB ( -- * Running sub-processes 20 | createProcess 21 | , shell, proc 22 | , CreateProcess(..) 23 | , CmdSpec(..) 24 | , ProcessHandle 25 | , LProcessHandle(..) 26 | -- ** Specific variants of createProcess 27 | , readProcess 28 | , readProcessWithExitCode 29 | -- * Process completion 30 | , waitForProcess, waitForProcessP 31 | , getProcessExitCode, getProcessExitCodeP 32 | , terminateProcess, terminateProcessP 33 | , closeHandles, closeHandlesP 34 | ) where 35 | 36 | import Prelude 37 | import LIO 38 | import LIO.MonadCatch 39 | import LIO.Handle 40 | import LIO.Handle.TCB (LHandle(..)) 41 | import LIO.TCB (rtioTCB, labelTCB) 42 | 43 | import Hails.CJail.Types.TCB 44 | 45 | import Data.Maybe 46 | 47 | import Control.Monad 48 | 49 | import System.Exit 50 | import System.Process (CmdSpec(..), ProcessHandle) 51 | import qualified System.Process as P 52 | 53 | -- | Data structure specifying how a command should be created 54 | data CreateProcess = CreateProcess 55 | { cmdspec :: CmdSpec 56 | -- ^ Executable and arguments, or BASH shell command 57 | , cwd :: Maybe FilePath 58 | -- ^ Optional path to the working directory 59 | , env :: [(String, String)] 60 | -- ^ Environment for new process 61 | } 62 | 63 | -- | Create a 'CreateProcess' representing a command to be passed to 64 | -- the shell 65 | shell :: String -> CreateProcess 66 | shell cmd = CreateProcess { cmdspec = ShellCommand cmd 67 | , cwd = Nothing 68 | , env = [] } 69 | 70 | -- | Create a 'CreateProcess' representing a raw command with arguements 71 | proc :: FilePath -> [String] -> CreateProcess 72 | proc cmd args = CreateProcess { cmdspec = RawCommand cmd args 73 | , cwd = Nothing 74 | , env = [] } 75 | 76 | -- | Labeled handle to process 77 | data LProcessHandle l = LProcessHandle 78 | { stdIn :: LHandle l 79 | -- ^ New standard in handle, will use default encoding and newline 80 | -- translation mode 81 | , stdOut :: LHandle l 82 | -- ^ New standard out handle, will use default encoding and newline 83 | -- translation mode 84 | , stdErr :: LHandle l 85 | -- ^ New standard error handle, will use default encoding and newline 86 | -- translation mode 87 | , processHandle :: Labeled l ProcessHandle 88 | -- ^ Handle to process 89 | } 90 | 91 | instance Show CmdSpec where 92 | show (ShellCommand s) = s 93 | show (RawCommand fp args) = unwords $ fp : args 94 | 95 | -- | Create a labeled process handle. The handle contains labeled 96 | -- handles to standard in, standard out, and standard error. Moreover, 97 | -- a labeled handle to the process itself (to e.g., terminate it) is 98 | -- also constructed. Internally, this function calls 99 | -- 'System.Process.createProcess'. 100 | -- 101 | -- For example to execute a simple @ls@ command: 102 | -- 103 | -- > import LIO.Handle 104 | -- > import qualified Data.ByteString.Lazy.Char8 as L8 105 | -- > ... 106 | -- > 107 | -- > ls :: LabelState l p s => LIO l p s L8.ByteString 108 | -- > ls = runCJail (CJailConf Nothing Nothing "/opt/cjail/app0-jail") $ do 109 | -- > lph <- createProcess (shell "ls") 110 | -- > liftLIO $ hGetContents $ stdOut lph 111 | -- 112 | -- or write and read from (same) temporary file with @cat@: 113 | -- 114 | -- > ex :: LabelState l p s => LIO l p s L8.ByteString 115 | -- > ex = runCJail (CJailConf Nothing Nothing "/opt/cjail/app0-jail") $ do 116 | -- > lph <- createProcess (shell "cat > /tmp/xxx ; cat /tmp/xxx") 117 | -- > liftLIO $ hPutStrLn (stdIn lph) (L8.pack "hello jail") 118 | -- > liftLIO $ hClose (stdIn lph) 119 | -- > liftLIO $ hGetContents $ stdOut lph 120 | -- 121 | -- Note that both of these examples use Lazy IO and thus the handles 122 | -- are not closed. More appropriately, the result from the jailed 123 | -- process should be forced (with e.g., 'evaluate') and the handles 124 | -- should be closed. Consider for example sorting a list of numbers 125 | -- with @sort@: 126 | -- 127 | -- > sort :: LabelState l p s => [Int] -> LIO l p s [Int] 128 | -- > sort ls = do 129 | -- > lph <- runCJail (CJailConf Nothing Nothing "/opt/cjail/splint-web") $ 130 | -- > createProcess (proc "sort" ["-n"]) 131 | -- > let input = L8.pack . intercalate "\n" . map show $ ls 132 | -- > hPut (stdIn lph) input 133 | -- > hClose (stdIn lph) 134 | -- > bs <- whileNotEOF (stdOut lph) [] 135 | -- > closeHandles lph 136 | -- > return bs 137 | -- > where whileNotEOF h acc = do 138 | -- > eof <- hIsEOF h 139 | -- > if eof 140 | -- > then return acc 141 | -- > else do res <- (read . L8.unpack) `liftM` hGetLine h 142 | -- > whileNotEOF h (res : acc) 143 | -- 144 | -- 145 | createProcess :: LabelState l p s 146 | => CreateProcess -> CJail l p s (LProcessHandle l) 147 | createProcess cp = do 148 | conf <- getCJailConf 149 | liftLIO $ do 150 | l <- getLabel 151 | (mh0, mh1, mh2, ph) <- rtioTCB $ P.createProcess $ mkCreateProcess conf cp 152 | [h0, h1, h2] <- getHandlesOrError [mh0, mh1, mh2] ph 153 | return LProcessHandle { stdIn = LHandleTCB l h0 154 | , stdOut = LHandleTCB l h1 155 | , stdErr = LHandleTCB l h2 156 | , processHandle = labelTCB l ph } 157 | where getHandlesOrError mhs ph = 158 | let hs = catMaybes mhs 159 | in if length mhs == length hs 160 | then return hs 161 | else do rtioTCB $ do mapM_ hClose hs 162 | void $ P.terminateProcess ph 163 | throwIO $ userError 164 | "createProcess could not create standard handles" 165 | 166 | -- | Fork an external process and read it standard output strictly, 167 | -- blocking until the process terminates and retuns an output string. 168 | -- The function throws an 'IOError' if the exit code is not 'ExitSuccess' 169 | -- Must compile with @-threaded@ if you want other threads to keep running 170 | -- while blocking on the result of @readProcess@ 171 | readProcess :: LabelState l p s 172 | => FilePath -- ^ Executable 173 | -> [String] -- ^ Arguments 174 | -> String -- ^ Standard input 175 | -> CJail l p s String -- ^ Standard output 176 | readProcess exe exeArgs stdin = do 177 | conf <- getCJailConf 178 | let (cjail, cjailArgs) = confToCmdArgs conf 179 | args = cjailArgs ++ (exe : exeArgs) 180 | liftLIO $ rtioTCB $ P.readProcess cjail args stdin 181 | 182 | -- | Same as 'readProcess', but returns the exit code explicitly, and 183 | -- strictly reads standard error. 184 | readProcessWithExitCode :: LabelState l p s 185 | => FilePath -- ^ Executable 186 | -> [String] -- ^ Arguments 187 | -> String -- ^ Standard input 188 | -> CJail l p s (ExitCode, String, String) -- ^ (exit code, stdout, stderr) 189 | readProcessWithExitCode exe exeArgs stdin = do 190 | conf <- getCJailConf 191 | let (cjail, cjailArgs) = confToCmdArgs conf 192 | args = cjailArgs ++ (exe : exeArgs) 193 | liftLIO $ rtioTCB $ P.readProcessWithExitCode cjail args stdin 194 | 195 | -- 196 | -- Process completion 197 | -- 198 | 199 | -- | Wait for specified process to terminate. This function raises the 200 | -- current label to the label of the process handle. 201 | -- Must compile with @-threaded@ if you want other threads to keep running 202 | -- while blocking on the result. 203 | waitForProcess :: LabelState l p s 204 | => LProcessHandle l -> LIO l p s ExitCode 205 | waitForProcess = waitForProcessP noPrivs 206 | 207 | -- | Same as 'waitForProcess', but uses privileges when raising current 208 | -- label. 209 | waitForProcessP :: LabelState l p s 210 | => p -> LProcessHandle l -> LIO l p s ExitCode 211 | waitForProcessP p' lph = withCombinedPrivs p' $ \p -> do 212 | ph <- unlabelP p $ processHandle lph 213 | rtioTCB $ P.waitForProcess ph 214 | 215 | -- | Get process exit code without blocking. This function raises the 216 | -- current label to the label of the process handle. 217 | getProcessExitCode :: LabelState l p s 218 | => LProcessHandle l -> LIO l p s (Maybe ExitCode) 219 | getProcessExitCode = getProcessExitCodeP noPrivs 220 | 221 | -- | Same as 'getProcessExitCode', but uses privileges when raising current 222 | -- label. 223 | getProcessExitCodeP :: LabelState l p s 224 | => p -> LProcessHandle l -> LIO l p s (Maybe ExitCode) 225 | getProcessExitCodeP p' lph = withCombinedPrivs p' $ \p -> do 226 | ph <- unlabelP p $ processHandle lph 227 | rtioTCB $ P.getProcessExitCode ph 228 | 229 | -- | Attempt to terminate the specified process. 230 | -- As noted in "System.Process", this function should not be used under 231 | -- normal circumstances. This function sends the process the @SIGTERM@ 232 | -- signal. 233 | -- It must be that the the current computation can both read and write 234 | -- the process handle. Furthermore, the 235 | -- current label is raised to the label of the process handle. 236 | terminateProcess :: LabelState l p s 237 | => LProcessHandle l -> LIO l p s () 238 | terminateProcess = terminateProcessP noPrivs 239 | 240 | -- | Same as 'terminateProcess', but uses privileges when raising current 241 | -- label. 242 | terminateProcessP :: LabelState l p s 243 | => p -> LProcessHandle l -> LIO l p s () 244 | terminateProcessP p' lph = withCombinedPrivs p' $ \p -> do 245 | wguardP p $ labelOf (processHandle lph) 246 | ph <- unlabelP p $ processHandle lph 247 | rtioTCB $ P.terminateProcess ph 248 | 249 | 250 | -- | Close all handles (simply calls 'hClose') 251 | closeHandles :: LabelState l p s => LProcessHandle l -> LIO l p s () 252 | closeHandles = closeHandlesP noPrivs 253 | 254 | -- | Close all handles, but uses privileges 255 | closeHandlesP :: LabelState l p s => p -> LProcessHandle l -> LIO l p s () 256 | closeHandlesP p' lph = withCombinedPrivs p' $ \p -> 257 | mapM_ (safeHClose p) [stdIn lph, stdOut lph, stdErr lph] 258 | where safeHClose p h = hCloseP p h `onException` return () 259 | 260 | -- 261 | -- Helpers 262 | -- 263 | 264 | -- | Make a @CreateProcess@ value usable by "System.Process" 265 | mkCreateProcess :: CJailConf -> CreateProcess -> P.CreateProcess 266 | mkCreateProcess conf cp = 267 | let (cjail, cjailArgs) = confToCmdArgs conf 268 | in P.CreateProcess 269 | { P.cmdspec = RawCommand cjail $ 270 | cjailArgs ++ cmdSpecToArgs (cmdspec cp) 271 | , P.cwd = cwd cp 272 | , P.env = Just $ env cp 273 | , P.std_in = P.CreatePipe 274 | , P.std_out = P.CreatePipe 275 | , P.std_err = P.CreatePipe 276 | , P.close_fds = True 277 | , P.create_group = False } 278 | 279 | -- | Conver 'CmdSpec' to list of arguments to @cjail@ 280 | cmdSpecToArgs :: CmdSpec -> [String] 281 | cmdSpecToArgs (ShellCommand s) = ["bash", "-c", s] 282 | cmdSpecToArgs (RawCommand fp s) = fp :s 283 | --------------------------------------------------------------------------------