├── .gitignore
├── Setup.hs
├── README.md
├── LICENSE
├── lio-cjail.cabal
├── examples
    └── example.hs
└── LIO
    ├── CJail.hs
    └── CJail
        └── System
            ├── Process
                └── TCB.hs
            └── Process.hs


/.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 | 


--------------------------------------------------------------------------------
/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 | 


--------------------------------------------------------------------------------
/lio-cjail.cabal:
--------------------------------------------------------------------------------
 1 | Name:           lio-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  <deian at cs dot stanford dot edu>
 8 | Stability:      experimental
 9 | Synopsis:       LIO bindings for the Arch Linux chroot-jail.
10 | Category:       Security
11 | Cabal-Version:  >= 1.6
12 | 
13 | Description:
14 |   LIO wrappers for "cjail", allowing code to execute arbitrary code in
15 |   a jail. Communication to said process is restricted using
16 |   information flow control as enforced by LIO.
17 |           
18 | 
19 | Source-repository head
20 |   Type:     git
21 |   Location: ssh://anonymous@gitstar.com/scs/lio-cjail.git
22 | 
23 | Library
24 |   Build-Depends:
25 |     base        >= 4.5 && < 5
26 |    ,mtl         >= 2.0
27 |    ,containers  >= 0.4.2
28 |    ,bytestring  >= 0.10
29 |    ,process     >= 1.1.0.1
30 |    ,lio         >= 0.9.2.2
31 |    ,cjail       >= 0.1
32 |    ,binary      >= 0.5.0.0
33 | 
34 |   ghc-options: -Wall -fno-warn-orphans
35 | 
36 |   Exposed-modules:
37 |     LIO.CJail
38 |     LIO.CJail.System.Process
39 |     LIO.CJail.System.Process.TCB
40 | 


--------------------------------------------------------------------------------
/examples/example.hs:
--------------------------------------------------------------------------------
 1 | import Control.Monad
 2 | import Data.Binary
 3 | import LIO
 4 | import LIO.DCLabel
 5 | import LIO.Handle
 6 | import LIO.TCB (ioTCB)
 7 | import LIO.CJail
 8 | import LIO.CJail.System.Process.TCB
 9 | import qualified Data.ByteString.Lazy.Char8 as L8
10 | import Data.List (intercalate)
11 | 
12 | jail_path :: FilePath
13 | jail_path = "/opt/cjail/tmp-jail"
14 | 
15 | main :: IO ()
16 | main = evalDC $ do
17 |   ls >>= ioTCB . L8.putStrLn
18 |   sort [2,38,1230,1234,1123,45,980,77,87] >>= ioTCB . putStrLn . show
19 |   ex >>= ioTCB . L8.putStrLn
20 | 
21 | ls :: (Label l, Binary l) => LIO l L8.ByteString
22 | ls = evalCJail (cJailConfTCB Nothing Nothing jail_path) $ do
23 |   lph <- createProcessL (shell "ls")
24 |   liftLIO $ hGetContents $ stdOut lph
25 | 
26 | sort :: (Label l, Binary l) => [Int] -> LIO l [Int]
27 | sort xs = evalCJail (cJailConfTCB Nothing Nothing jail_path) $ do
28 |   lph <- createProcessL (proc "sort" ["-n"])
29 |   let input = L8.pack . intercalate "\n" . map show $ xs
30 |   hPut (stdIn lph) input
31 |   hClose (stdIn lph)
32 |   bs <- whileNotEOF (stdOut lph) []
33 |   closeHandles lph
34 |   return bs
35 |     where whileNotEOF h acc = do
36 |             eof <- hIsEOF  h
37 |             if eof
38 |               then return acc
39 |               else do res <- (read . L8.unpack) `liftM` hGetLine h
40 |                       whileNotEOF h (res : acc)
41 | 
42 | ex :: (Label l, Binary l) => LIO l L8.ByteString
43 | ex = evalCJail (cJailConfTCB Nothing Nothing jail_path) $ do
44 |   lph <- createProcessL (shell "cat > /tmp/xxx ; cat /tmp/xxx")
45 |   hPutStrLn (stdIn lph) (L8.pack "hello jail")
46 |   hClose (stdIn lph)
47 |   hGetContents $ stdOut lph
48 | 


--------------------------------------------------------------------------------
/LIO/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 "LIO.CJail.System.Process.hs".
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 | * @LIO_CJAIL_TIMEOUT@ corresponds to the @--timeout@ option.
17 | 
18 | * @LIO_CJAIL_DIR@ corresponds to the @cjail@ jail.
19 | 
20 | The @LIO_CJAIL_DIR@ variable must be defined, otherwise 'inJail'
21 | throws an exception.
22 | 
23 | -}
24 | module LIO.CJail ( inCJail
25 |                  , module LIO.CJail.System.Process
26 |                  ) where
27 | 
28 | import Data.Maybe (listToMaybe)
29 | 
30 | import LIO
31 | import LIO.TCB (rethrowIoTCB)
32 | import LIO.CJail.System.Process
33 | import LIO.CJail.System.Process.TCB (CJailConf(..))
34 | import qualified CJail.System.Process as C
35 | 
36 | import System.Environment
37 | 
38 | -- | Execute a jailed process in a cjail, configured according to the
39 | -- current environment.
40 | inCJail :: Label l => CJail l a -> LIO l a
41 | inCJail io = do
42 |   e <- rethrowIoTCB getEnvironment
43 |   case lookup "LIO_CJAIL_DIR" e of
44 |     Nothing  -> throwLIO . userError $ "CJail not configured"
45 |     Just dir -> evalCJail (CJailConfTCB $ 
46 |                             C.CJailConf { C.cjUser = Nothing
47 |                                         , C.cjTimeout = toutFromEnv
48 |                                         , C.cjDir = dir }) io
49 |         where toutFromEnv = do tS <- lookup "LIO_CJAIL_TIMEOUT" e
50 |                                maybeRead tS
51 |               maybeRead :: Read a => String -> Maybe a
52 |               maybeRead = fmap fst . listToMaybe . reads
53 | 


--------------------------------------------------------------------------------
/LIO/CJail/System/Process/TCB.hs:
--------------------------------------------------------------------------------
 1 | {- |
 2 |   This module export the 'CJail' monad in which untrusted code can
 3 |   spawn new processes and communicate with them. 'CJail' is a wrapper
 4 |   for 'LIO', encapsulating the jail configuration that untrusted code
 5 |   should not be able to modify.
 6 | -}
 7 | 
 8 | {-# LANGUAGE Unsafe
 9 |            , MultiParamTypeClasses
10 |            , FlexibleContexts
11 |            , FlexibleInstances
12 |            , UndecidableInstances
13 |            , GeneralizedNewtypeDeriving
14 |            , DeriveFunctor #-}
15 | 
16 | 
17 | module LIO.CJail.System.Process.TCB ( -- * CJail Monad
18 |                                       CJail(..), evalCJail
19 |                                     , CJailConf(..)
20 |                                     , cJailConfTCB
21 |                                     , getCJailConfTCB 
22 |                                     ) where
23 | 
24 | import           LIO
25 | import           LIO.Handle
26 | import           LIO.TCB (ShowTCB(..))
27 | import           Control.Monad.Reader
28 | import           Control.Applicative
29 | import qualified CJail.System.Process as C
30 | 
31 | --
32 | -- CJail config
33 | --
34 | 
35 | -- | Data-type used to encode the jail configuration information.
36 | newtype CJailConf = CJailConfTCB  { unCJailConfTCB :: C.CJailConf }
37 | 
38 | instance ShowTCB CJailConf where
39 |   showTCB = show . unCJailConfTCB 
40 | 
41 | -- | Create a new configuration
42 | cJailConfTCB :: Maybe String  -- ^ User
43 |              -> Maybe Int     -- ^ Timeout in seconds
44 |              -> FilePath      -- ^ Path to jail
45 |              -> CJailConf
46 | cJailConfTCB mu mt fp = CJailConfTCB $ C.CJailConf { C.cjUser    = mu
47 |                                                    , C.cjTimeout = mt
48 |                                                    , C.cjDir     = fp }
49 | 
50 | 
51 | --
52 | -- CJail monad
53 | --
54 | 
55 | -- | CJailed monad wrapper for the "LIO" monad.
56 | newtype CJail l a = CJailTCB { unCJailTCB :: ReaderT CJailConf (LIO l) a }
57 |   deriving (Functor, Applicative, Monad)
58 | 
59 | instance Label l => MonadLIO l (CJail l) where
60 |   liftLIO = CJailTCB . lift
61 | 
62 | -- | Execute a CJail computation
63 | evalCJail :: Label l => CJailConf -> CJail l a -> LIO l a
64 | evalCJail conf m = runReaderT (unCJailTCB m) conf
65 | 
66 | -- | Get underlying configuration
67 | getCJailConfTCB :: CJail l CJailConf
68 | getCJailConfTCB = CJailTCB ask
69 | 
70 | instance (Label l, HandleOps h b (LIO l)) => HandleOps h b (CJail l) where
71 |   hGet h i            = liftLIO $ hGet h i
72 |   hGetNonBlocking h i = liftLIO $ hGetNonBlocking h i
73 |   hGetContents        = liftLIO . hGetContents
74 |   hGetLine            = liftLIO . hGetLine
75 |   hPut h b            = liftLIO $ hPut h b
76 |   hPutStr h b         = liftLIO $ hPutStr h b
77 |   hPutStrLn h b       = liftLIO $ hPutStrLn h b
78 | 


--------------------------------------------------------------------------------
/LIO/CJail/System/Process.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE Trustworthy #-}
  2 | {-
  3 |   This module export the 'CJail' monad in which untrusted code can
  4 |   spawn new processes and communicate with them. 'CJail' is a wrapper
  5 |   for 'LIO', encapsulating the jail configuration that untrusted code
  6 |   should not be able to modify.
  7 | -}
  8 | module LIO.CJail.System.Process (
  9 |     -- * CJail Monad
 10 |     CJail, evalCJail
 11 |   , CJailConf
 12 |   -- * Running sub-processes
 13 |   , createProcessL
 14 |   , createProcess
 15 |   , createProcessP
 16 |   , shell, proc
 17 |   , CreateProcess(..)
 18 |   , CmdSpec(..)
 19 |   , LabeledProcessHandle(..)
 20 |   -- ** Specific variants of createProcess
 21 |   , readProcess
 22 |   , readProcessWithExitCode
 23 |   -- * Process completion
 24 |   , waitForProcess, waitForProcessP
 25 |   , getProcessExitCode, getProcessExitCodeP
 26 |   , terminateProcess, terminateProcessP
 27 |   , closeHandles, closeHandlesP
 28 |   ) where
 29 | 
 30 | import           Data.Binary
 31 | import           Control.Monad
 32 | 
 33 | import           LIO
 34 | import           LIO.Handle
 35 | import           LIO.TCB (rethrowIoTCB)
 36 | import           LIO.CJail.System.Process.TCB
 37 | 
 38 | import           CJail.System.Process ( shell, proc
 39 |                                       , CreateProcess(..)
 40 |                                       , CmdSpec(..) )
 41 | import qualified CJail.System.Process as C
 42 | import qualified System.Process as P
 43 | import           System.Exit
 44 | 
 45 | --
 46 | -- Handles
 47 | --
 48 | 
 49 | -- | Labeled handle to process
 50 | data LabeledProcessHandle l = LabeledProcessHandle
 51 |   { stdIn  :: LabeledHandle l
 52 |   -- ^ New standard in handle, will use default encoding and newline
 53 |   -- translation mode
 54 |   , stdOut :: LabeledHandle l
 55 |   -- ^ New standard out handle, will use default encoding and newline
 56 |   -- translation mode
 57 |   , stdErr :: LabeledHandle l
 58 |   -- ^ New standard error handle, will use default encoding and newline
 59 |   -- translation mode
 60 |   , processHandle :: Labeled l P.ProcessHandle
 61 |   -- ^ Handle to process
 62 |   }
 63 | 
 64 | --
 65 | --
 66 | --
 67 | 
 68 | -- | Create a process handle. The handle contains labeled handles to
 69 | -- standard in, standard out, and standard error. Moreover, a handle
 70 | -- to the process itself  is also constructed. Internally, this
 71 | -- function calls 'System.Process.createProcess'. The label of the
 72 | -- process handle must be bounded by the current label and clerance.
 73 | --
 74 | -- For example to execute a simple @ls@ command:
 75 | --
 76 | -- > import qualified Data.ByteString.Lazy.Char8 as L8
 77 | -- > ...
 78 | -- >
 79 | -- > ls :: (Label l, Binary l) => LIO l L8.ByteString
 80 | -- > ls = evalCJail (cJailConfTCB Nothing Nothing jail_path) $ do
 81 | -- >   lph <- createProcessL (shell "ls")
 82 | -- >   liftLIO $ hGetContents $ stdOut lph
 83 | --
 84 | -- or write and read from (same) temporary file with @cat@:
 85 | --
 86 | -- > ex :: (Label l, Binary l) => LIO l L8.ByteString
 87 | -- > ex = evalCJail (cJailConfTCB Nothing Nothing jail_path) $ do
 88 | -- >   lph <- createProcessL (shell "cat > /tmp/xxx ; cat /tmp/xxx")
 89 | -- >   hPutStrLn (stdIn lph) (L8.pack "hello jail")
 90 | -- >   hClose (stdIn lph)
 91 | -- >   hGetContents $ stdOut lph
 92 | --
 93 | -- Note that both of these examples use Lazy IO and thus the handles
 94 | -- are not closed. More appropriately, the result from the jailed
 95 | -- process should be forced (with e.g., 'evaluate') and the handles
 96 | -- should be closed. Consider for example sorting a list of numbers
 97 | -- with @sort@:
 98 | --
 99 | -- > sort :: (Label l, Binary l) => [Int] -> LIO l [Int]
100 | -- > sort xs = evalCJail (cJailConfTCB Nothing Nothing jail_path) $ do
101 | -- >   lph <- createProcessL (proc "sort" ["-n"])
102 | -- >   let input = L8.pack . intercalate "\n" . map show $ xs
103 | -- >   hPut (stdIn lph) input
104 | -- >   hClose (stdIn lph)
105 | -- >   bs <- whileNotEOF (stdOut lph) []
106 | -- >   closeHandles lph
107 | -- >   return bs
108 | -- >     where whileNotEOF h acc = do
109 | -- >             eof <- hIsEOF  h
110 | -- >             if eof
111 | -- >               then return acc
112 | -- >               else do res <- (read . L8.unpack) `liftM` hGetLine h
113 | -- >                       whileNotEOF h (res : acc)
114 | --
115 | --
116 | createProcess :: Label l
117 |               => l -> CreateProcess -> CJail l (LabeledProcessHandle l)
118 | createProcess = createProcessP NoPrivs
119 | 
120 | 
121 | -- | Same as 'createProcess', but uses privileges.
122 | createProcessP :: Priv l p 
123 |                => p -> l -> CreateProcess -> CJail l (LabeledProcessHandle l)
124 | createProcessP p l cp = do
125 |   guardAllocP p l
126 |   conf <- unCJailConfTCB `liftM` getCJailConfTCB
127 |   liftLIO $ do
128 |     ph <- rethrowIoTCB $ C.createProcess conf cp
129 |     li <- labelP p l $ C.stdIn  ph 
130 |     lo <- labelP p l $ C.stdOut ph 
131 |     le <- labelP p l $ C.stdErr ph 
132 |     lp <- labelP p l $ C.processHandle ph
133 |     return $ LabeledProcessHandle { stdIn         = li
134 |                                   , stdOut        = lo
135 |                                   , stdErr        = le
136 |                                   , processHandle = lp }
137 | 
138 | -- | Same as 'createProcess', but uses the current label as the label
139 | -- of the handles.
140 | createProcessL :: Label l => CreateProcess -> CJail l (LabeledProcessHandle l)
141 | createProcessL cp = do
142 |   l <- getLabel 
143 |   createProcess l cp
144 | 
145 | -- | Fork an external process and read it standard output strictly,
146 | -- blocking until the process terminates and retuns an output string.
147 | -- The function throws an 'IOError' if the exit code is not 'ExitSuccess'
148 | -- Must compile with @-threaded@ if you want other threads to keep running
149 | -- while blocking on the result of @readProcess@
150 | readProcess :: Label l 
151 |             => FilePath        -- ^ Executable
152 |             -> [String]        -- ^ Arguments
153 |             -> String          -- ^ Standard input
154 |             -> CJail l String  -- ^ Standard output
155 | readProcess exe exeArgs stdin' = do
156 |   conf <- unCJailConfTCB `liftM` getCJailConfTCB
157 |   liftLIO . rethrowIoTCB $ C.readProcess conf exe exeArgs stdin'
158 | 
159 | -- | Same as 'readProcess', but returns the exit code explicitly, and
160 | -- strictly reads standard error.
161 | readProcessWithExitCode ::  Label l
162 |                         => FilePath -- ^ Executable
163 |                         -> [String] -- ^ Arguments
164 |                         -> String   -- ^ Standard input
165 |                         -> CJail l (ExitCode, String, String)
166 |                            -- ^ (exit code, stdout, stderr)
167 | readProcessWithExitCode exe exeArgs stdin' = do
168 |   conf <- unCJailConfTCB `liftM` getCJailConfTCB
169 |   liftLIO . rethrowIoTCB $ C.readProcessWithExitCode conf exe exeArgs stdin'
170 | 
171 | --
172 | -- Process completion
173 | --
174 | 
175 | -- | Wait for specified process to terminate.  Must compile with
176 | -- @-threaded@ if you want other threads to keep running while blocking
177 | -- on the result.
178 | waitForProcess :: Label l => LabeledProcessHandle l -> CJail l ExitCode
179 | waitForProcess = waitForProcessP NoPrivs
180 | 
181 | -- | Same as 'waitForProcess', but uses privileges.
182 | waitForProcessP :: Priv l p => p -> LabeledProcessHandle l -> CJail l ExitCode
183 | waitForProcessP p lph = do
184 |   ph <- unlabelP p $ processHandle lph
185 |   liftLIO . rethrowIoTCB $ P.waitForProcess ph
186 | 
187 | -- | Get process exit code without blocking.
188 | getProcessExitCode :: Label l 
189 |                    => LabeledProcessHandle l -> CJail l (Maybe ExitCode)
190 | getProcessExitCode = getProcessExitCodeP NoPrivs
191 | 
192 | -- | Same as 'getProcessExitCode', but uses privileges.
193 | getProcessExitCodeP :: Priv l p 
194 |                     => p ->  LabeledProcessHandle l -> CJail l (Maybe ExitCode)
195 | getProcessExitCodeP p lph = do
196 |   ph <- unlabelP p $ processHandle lph
197 |   liftLIO . rethrowIoTCB $ P.getProcessExitCode ph
198 | 
199 | -- | Attempt to terminate the specified process.
200 | -- As noted in "System.Process", this function should not be used under
201 | -- normal circumstances. This function sends the process the @SIGTERM@
202 | -- signal.
203 | terminateProcess :: Label l => LabeledProcessHandle l -> CJail l ()
204 | terminateProcess = terminateProcessP NoPrivs
205 | 
206 | -- | Same as 'terminateProcess', but uses privileges.
207 | terminateProcessP :: Priv l p => p -> LabeledProcessHandle l -> CJail l ()
208 | terminateProcessP p lph = do
209 |   guardWriteP p $ labelOf $ processHandle lph
210 |   ph <- unlabelP p $ processHandle lph
211 |   liftLIO . rethrowIoTCB $ P.terminateProcess ph
212 |   
213 | 
214 | -- | Close all handles (simply calls 'hClose')
215 | closeHandles :: (Label l, Binary l) 
216 |              => LabeledProcessHandle l -> CJail l ()
217 | closeHandles = closeHandlesP NoPrivs
218 | 
219 | -- | Same as 'closeHandles', but uses privileges.
220 | closeHandlesP :: (Priv l p, Binary l) 
221 |               => p -> LabeledProcessHandle l -> CJail l ()
222 | closeHandlesP p lph = liftLIO $ mapM_ safeHClose [stdIn lph
223 |                                                  , stdOut lph
224 |                                                  , stdErr lph]
225 |   where safeHClose h = hCloseP p h `onException` return ()
226 | 


--------------------------------------------------------------------------------