jail (empty) → 0.0.1
raw patch · 4 files changed
+604/−0 lines, 4 filesdep +basedep +containersdep +directorysetup-changed
Dependencies added: base, containers, directory, monads-fd, transformers
Files
- LICENSE +28/−0
- Setup.lhs +6/−0
- jail.cabal +75/−0
- src/System/IO/Jail.hs +495/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) Sebastiaan Visser 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#! /usr/bin/env runhaskell++>import Distribution.Simple++>main = defaultMain+
+ jail.cabal view
@@ -0,0 +1,75 @@+Name: jail+Version: 0.0.1+Description:++ Like all of us know, the IO monad from the System.IO module+ is a wild beast allowing all forms of insecure computations+ that can read, or even worse, alter /the real world/. Writing+ to sockets, deleting files or even launching missiles, its+ possibilities are endless. This library provides a special+ IO module that wraps all file and handle based IO operations+ from the System.IO module, but provides a possibility to run+ them in an restricted environment. When running a jailed IO+ computation a file path can be specified all IO operations+ will be checked against. Accessing files outside this+ directory is not allowed and results in a runtime error.+ Additionally, when running a jailed IO computation a+ whitelist of file handles can be specified that are+ accessible as well.+ .++ For example, running some code with the permission to access+ all files within (and only within) my home directory and+ allowing to access the standard output and standard error can+ be enforced like this:+ .++ > Jail.run (Just "/home/sebas") [stdout, stderr] yourUntrustworthyComputation+ .++ Only allowing the code to access the standard input and+ nothing else can be enforced like this:+ .++ > Jail.run Nothing [stdin] yourEvenMoreUntrustworthyComputation+ .++ Because the jailed IO environment keeps track of all file+ handles and checks that are opened by its own operations,+ smuggling in evil file handles from the fierce and dangerous+ outside world will be punished by border patrol. Only handles+ from the whitelist or handles securely opened by functions+ like `openFile' will be accepted. Because of the opaque IO+ constructor and the restricted set of exported operations+ this module is not easily fooled.+ .++ I would almost dare to say this module is conceptually safe+ and code with the jailed IO type can blindly be trusted.+ Except, yes unfortunately except, @unsafePerformIO@ ruins it+ all. I would almost suggest adding a flag to the compiler to+ enforce the absence of @unsafeRuinMyTypeSafety@-alike+ functions in order to be able to create systems in which code+ can be trusted by its type alone.+ .+ Nonetheless, this module is one step forward in trusting your+ own programs. Some real <http://tinyurl.com/paranoidpeople>+ prefer writing there software in one of the most insecure+ programming languages and perform security audits by hand,+ I'd rather have my compiler do the job. (Anyone who wants to+ audit this library is more than welcome!)++Synopsis: Jailed IO monad.+Category: System, Security+Cabal-Version: >= 1.6+License: BSD3+License-file: LICENSE+Author: Sebastiaan Visser+Maintainer: sfvisser@cs.uu.nl+Build-Type: Simple+Build-Depends: base >= 3 && <= 5, containers ==0.2.*, directory ==1.0.*, monads-fd ==0.0.*, transformers ==0.1.*++GHC-Options: -Wall+HS-Source-Dirs: src+Exposed-modules: System.IO.Jail+
+ src/System/IO/Jail.hs view
@@ -0,0 +1,495 @@+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+module System.IO.Jail+ ( -- * The IO monad++ IO, -- instance MonadFix+ run,+ JailIO (..),++ -- * Files and handles++ FilePath, -- :: String++ Handle, -- abstract, instance of: Eq, Show.++ -- | Three handles are allocated during program initialisation,+ -- and are initially open.++ stdin, stdout, stderr, -- :: Handle++ -- * Opening and closing files++ -- ** Opening files++ withFile,+ openFile, -- :: FilePath -> IOMode -> IO Handle+ IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),++ -- ** Closing files++ hClose, -- :: Handle -> IO ()++ -- ** Special cases++ readFile, -- :: FilePath -> IO String+ writeFile, -- :: FilePath -> String -> IO ()+ appendFile, -- :: FilePath -> String -> IO ()++ -- ** File locking++ -- $locking++ -- * Operations on handles++ -- ** Determining and changing the size of a file++ hFileSize, -- :: Handle -> IO Integer++#ifdef __GLASGOW_HASKELL__+ hSetFileSize, -- :: Handle -> Integer -> IO ()+#endif++ -- ** Detecting the end of input++ hIsEOF, -- :: Handle -> IO Bool+ isEOF, -- :: IO Bool++ -- ** Buffering operations++ BufferMode(NoBuffering,LineBuffering,BlockBuffering),+ hSetBuffering, -- :: Handle -> BufferMode -> IO ()+ hGetBuffering, -- :: Handle -> IO BufferMode+ hFlush, -- :: Handle -> IO ()++ -- ** Repositioning handles++ hGetPosn, -- :: Handle -> IO HandlePosn+ hSetPosn, -- :: HandlePosn -> IO ()+ HandlePosn, -- abstract, instance of: Eq, Show.++ hSeek, -- :: Handle -> SeekMode -> Integer -> IO ()+ SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),++#if !defined(__NHC__)+ hTell, -- :: Handle -> IO Integer+#endif++ -- ** Handle properties++ hIsOpen, hIsClosed, -- :: Handle -> IO Bool+ hIsReadable, hIsWritable, -- :: Handle -> IO Bool+ hIsSeekable, -- :: Handle -> IO Bool++ -- ** Terminal operations (not portable: GHC\/Hugs only)++#if !defined(__NHC__)+ hIsTerminalDevice, -- :: Handle -> IO Bool++ hSetEcho, -- :: Handle -> Bool -> IO ()+ hGetEcho, -- :: Handle -> IO Bool+#endif++ -- ** Showing handle state (not portable: GHC only)++#ifdef __GLASGOW_HASKELL__+ hShow, -- :: Handle -> IO String+#endif++ -- * Text input and output++ -- ** Text input++ hWaitForInput, -- :: Handle -> Int -> IO Bool+ hReady, -- :: Handle -> IO Bool+ hGetChar, -- :: Handle -> IO Char+ hGetLine, -- :: Handle -> IO [Char]+ hLookAhead, -- :: Handle -> IO Char+ hGetContents, -- :: Handle -> IO [Char]++ -- ** Text output++ hPutChar, -- :: Handle -> Char -> IO ()+ hPutStr, -- :: Handle -> [Char] -> IO ()+ hPutStrLn, -- :: Handle -> [Char] -> IO ()+ hPrint, -- :: Show a => Handle -> a -> IO ()++ -- ** Special cases for standard input and output++ interact, -- :: (String -> String) -> IO ()+ putChar, -- :: Char -> IO ()+ putStr, -- :: String -> IO () + putStrLn, -- :: String -> IO ()+ print, -- :: Show a => a -> IO ()+ getChar, -- :: IO Char+ getLine, -- :: IO String+ getContents, -- :: IO String+ readIO, -- :: Read a => String -> IO a+ readLn, -- :: Read a => IO a++ -- * Binary input and output++ withBinaryFile,+ openBinaryFile, -- :: FilePath -> IOMode -> IO Handle+ hSetBinaryMode, -- :: Handle -> Bool -> IO ()+ hPutBuf, -- :: Handle -> Ptr a -> Int -> IO ()+ hGetBuf, -- :: Handle -> Ptr a -> Int -> IO Int++#if !defined(__NHC__) && !defined(__HUGS__)+ hPutBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int+ hGetBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int+#endif++ -- * Temporary files++ openTempFile,+ openBinaryTempFile,+ )+where++import Control.Applicative+import Control.Monad.Cont+import Control.Monad.Error+import Control.Monad.Trans.Identity+import Control.Monad.List+import Control.Monad.RWS+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Writer+import Data.List+import Data.Set (Set)+import Data.Typeable+import Foreign.Ptr+import Prelude hiding (readFile, writeFile, print, appendFile, IO, getChar, getLine, getContents, readIO, readLn, interact, putChar, putStr, putStrLn)+import System.Directory+import System.IO (IOMode, Handle, BufferMode, HandlePosn, SeekMode, stdin, stdout, stderr)+import qualified Data.Set as Set+import qualified System.IO as U++-- Make `Handle's orderable.++data HandleS = HandleS String Handle++mkHWrap :: Handle -> HandleS+mkHWrap h = HandleS (show h) h++instance Eq HandleS where+ (HandleS _ s) == (HandleS _ t) = s == t++instance Ord HandleS where+ (HandleS s _) `compare` (HandleS t _) = s `compare` t++-- | The jailed IO monad.++newtype IO a = IO { unJail :: ReaderT (Maybe FilePath) (StateT (Set HandleS) U.IO) a}+ deriving (Functor, Applicative, Monad, Typeable, MonadFix)++-- | Like `MonadIO`, but for jailed computations.++class Monad m => JailIO m where+ jailIO :: IO a -> m a++instance JailIO IO where+ jailIO = id++instance JailIO m => JailIO (ContT r m) where jailIO = lift . jailIO+instance (Error e, JailIO m) => JailIO (ErrorT e m) where jailIO = lift . jailIO+instance JailIO m => JailIO (IdentityT m) where jailIO = lift . jailIO+instance JailIO m => JailIO (ListT m) where jailIO = lift . jailIO+instance (Monoid w, JailIO m) => JailIO (RWST r w s m) where jailIO = lift . jailIO+instance JailIO m => JailIO (ReaderT r m) where jailIO = lift . jailIO+instance JailIO m => JailIO (StateT r m) where jailIO = lift . jailIO+instance (Monoid r, JailIO m) => JailIO (WriterT r m) where jailIO = lift . jailIO++{- |+Run a jailed IO computation. The IO computation will be able to access all+files that are within the specified jail directory. All file accesses outside+the jail directory will be refused. Only file handles opened from within the+jailed computation and the handles from the white list will be accessible to+the operations requiring a file handle. No smuggling in of foreign handles,+border patrol is very strict. When the jail path is specified as `Nothing' no+file access will be possible at all, this means the computation can only rely+on the white listed handles.+-}++run+ :: Maybe FilePath -- ^ The jail directory or `Nothing' for not allowing file access.+ -> [Handle] -- ^ A white list of handles that are always accessible.+ -> IO a -- ^ The jailed IO computation to run.+ -> U.IO a -- ^ Run the computation from within the insecure real world.+run jail = runRaw jail . Set.fromList . map mkHWrap++runRaw :: Maybe FilePath -> Set HandleS -> IO a -> U.IO a+runRaw p h =+ flip evalStateT h+ . flip runReaderT p+ . unJail++isSubPathOf :: FilePath -> FilePath -> U.IO Bool+isSubPathOf path jail = isPrefixOf <$> canonicalizePath jail <*> canonicalizePath path++-- Unconditionally, embed an IO action into the Jail monad. Not to be exported!++io :: U.IO a -> IO a+io = IO . liftIO++-- Allow a new Handle.++allow :: Handle -> IO ()+allow h = (IO . lift) (modify (Set.insert (mkHWrap h)))++{-+Embed an IO action that takes a FilePath as input. The IO action will only+executed when the path is within the jail directory. Not to be exported!+-}++embedPath :: String -> (FilePath -> U.IO a) -> FilePath -> IO a+embedPath name action path = + do jail <- IO ask + safe <- io (maybe (return False) (path `isSubPathOf`) jail)+ if safe+ then io (action path)+ else error (name ++ ": Permission denied, filepath outside jailed environment. "+ ++ show path)++{-+Embed an IO action that takes a `Handle' as input. The IO action will only+executed when the handle is opened from within the jailed IO monad. Not to be+exported!+-}++embedHandles :: String -> ([Handle] -> U.IO a) -> [Handle] -> IO a+embedHandles name action handles = + do set <- IO (lift get)+ if all (\h -> mkHWrap h `Set.member` set) handles+ then io (action handles)+ else error (name ++ ": Permission denied, handle from outside jailed environment. "+ ++ show handles)++embedHandle :: String -> (Handle -> U.IO a) -> Handle -> IO a+embedHandle name action handle = embedHandles name (action . head) [handle]++-- Embedded IO actions.++withFile :: FilePath -> IOMode -> (Handle -> IO a) -> IO a+withFile f m w =+ do r <- runRaw <$> IO ask <*> IO (lift get)+ embedPath "withFile" (\f' -> U.withFile f' m (\h -> r (allow h >> w h))) f++openFile :: FilePath -> IOMode -> IO Handle+openFile f m =+ do h <- embedPath "openFile" (flip U.openFile m) f+ allow h+ return h++hClose :: Handle -> IO ()+hClose = io . U.hClose++--++readFile :: FilePath -> IO String+readFile = embedPath "readFile" U.readFile++writeFile :: FilePath -> String -> IO ()+writeFile f s = embedPath "writeFile" (flip U.writeFile s) f++appendFile :: FilePath -> String -> IO ()+appendFile f s = embedPath "appendFile" (flip U.appendFile s) f++--++hFileSize :: Handle -> IO Integer+hFileSize = embedHandle "hFileSize" U.hFileSize++#ifdef __GLASGOW_HASKELL__++hSetFileSize :: Handle -> Integer -> IO ()+hSetFileSize h i = embedHandle "setFileSize" (flip U.hSetFileSize i) h++#endif++--++hIsEOF :: Handle -> IO Bool+hIsEOF = io . U.hIsEOF++isEOF :: IO Bool+isEOF = io U.isEOF++--++hSetBuffering :: Handle -> BufferMode -> IO ()+hSetBuffering h m = embedHandle "hSetBuffering" (flip U.hSetBuffering m) h++hGetBuffering :: Handle -> IO BufferMode+hGetBuffering = embedHandle "hGetBuffering" U.hGetBuffering++hFlush :: Handle -> IO ()+hFlush = embedHandle "hFlush" U.hFlush++--++hGetPosn :: Handle -> IO HandlePosn+hGetPosn = embedHandle "hGetPosn" U.hGetPosn++hSetPosn :: HandlePosn -> IO ()+hSetPosn = io . U.hSetPosn++hSeek :: Handle -> SeekMode -> Integer -> IO ()+hSeek h m i = embedHandle "hSeek" (\h' -> U.hSeek h' m i) h++#if !defined(__NHC__)++hTell :: Handle -> IO Integer+hTell = embedHandle "hTell" U.hTell++#endif++--++hIsOpen :: Handle -> IO Bool+hIsOpen = embedHandle "hIsOpen" U.hIsOpen++hIsClosed :: Handle -> IO Bool+hIsClosed = embedHandle "hIsClosed" U.hIsClosed++hIsReadable :: Handle -> IO Bool+hIsReadable = embedHandle "hIsReadable" U.hIsReadable++hIsWritable :: Handle -> IO Bool+hIsWritable = embedHandle "hIsWritable" U.hIsWritable++hIsSeekable :: Handle -> IO Bool+hIsSeekable = embedHandle "hIsSeekable" U.hIsSeekable++--++#if !defined(__NHC__)++hIsTerminalDevice :: Handle -> IO Bool+hIsTerminalDevice = embedHandle "hIsTerminalDevice" U.hIsTerminalDevice++hSetEcho :: Handle -> Bool -> IO ()+hSetEcho h e = embedHandle "hSetEcho" (flip U.hSetEcho e) h++hGetEcho :: Handle -> IO Bool+hGetEcho = embedHandle "hGetEcho" U.hGetEcho++#endif++--++#ifdef __GLASGOW_HASKELL__++hShow :: Handle -> IO String+hShow = embedHandle "hShow" U.hShow++#endif++--++hWaitForInput :: Handle -> Int -> IO Bool+hWaitForInput h i = embedHandle "hWaitForInput" (flip U.hWaitForInput i) h++hReady :: Handle -> IO Bool+hReady = embedHandle "hReady" U.hReady++hGetChar :: Handle -> IO Char+hGetChar = embedHandle "hGetChar" U.hGetChar++hGetLine :: Handle -> IO String+hGetLine = embedHandle "hGetLine" U.hGetLine++hLookAhead :: Handle -> IO Char+hLookAhead = embedHandle "hLookAhead" U.hLookAhead++hGetContents :: Handle -> IO String+hGetContents = embedHandle "hGetContents" U.hGetContents++--++hPutChar :: Handle -> Char -> IO ()+hPutChar h c = embedHandle "hPutChar" (flip U.hPutChar c) h++hPutStr :: Handle -> String -> IO ()+hPutStr h s = embedHandle "hPutStr" (flip U.hPutStr s) h++hPutStrLn :: Handle -> String -> IO ()+hPutStrLn h s = embedHandle "hPutStrLn" (flip U.hPutStrLn s) h++hPrint :: Show a => Handle -> a -> IO ()+hPrint h s = embedHandle "hPrint" (flip U.hPrint s) h++--++interact :: (String -> String) -> IO ()+interact a = embedHandles "interact" (const (U.interact a)) [stdout, stdin]++putChar :: Char -> IO ()+putChar a = embedHandle "putChar" (const (U.putChar a)) stdout++putStr :: String -> IO ()+putStr a = embedHandle "putStr" (const (U.putStr a)) stdout++putStrLn :: String -> IO ()+putStrLn a = embedHandle "putStrLn" (const (U.putStrLn a)) stdout++print :: Show a => a -> IO ()+print a = embedHandle "print" (const (U.print a)) stdout++--++getChar :: IO Char+getChar = embedHandle "getChar" (const U.getChar) stdin++getLine :: IO String+getLine = embedHandle "getLine" (const U.getLine) stdin++getContents :: IO String+getContents = embedHandle "getContents" (const U.getContents) stdin++readIO :: Read a => String -> IO a+readIO s = embedHandle "readIO" (const (U.readIO s)) stdin++readLn :: Read a => IO a+readLn = embedHandle "readLn" (const U.readLn) stdin++--++withBinaryFile :: FilePath -> IOMode -> (Handle -> IO a) -> IO a+withBinaryFile f m w =+ do r <- runRaw <$> IO ask <*> IO (lift get)+ embedPath "withBinaryFile" (\f' -> U.withBinaryFile f' m (\h -> r (allow h >> w h))) f++openBinaryFile :: FilePath -> IOMode -> IO Handle+openBinaryFile f m =+ do h <- embedPath "openBinaryFile" (flip U.openBinaryFile m) f+ allow h+ return h++hSetBinaryMode :: Handle -> Bool -> IO ()+hSetBinaryMode h b = embedHandle "hSetBinaryMode" (flip U.hSetBinaryMode b) h++hPutBuf :: Handle -> Ptr a -> Int -> IO ()+hPutBuf h p i = embedHandle "hPutBuf" (\h' -> U.hPutBuf h' p i) h++hGetBuf :: Handle -> Ptr a -> Int -> IO Int+hGetBuf h p i = embedHandle "hGetBuf" (\h' -> U.hGetBuf h' p i) h++#if !defined(__NHC__) && !defined(__HUGS__)++hPutBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int+hPutBufNonBlocking h p i = embedHandle "hPutBufNonBlocking" (\h' -> U.hPutBufNonBlocking h' p i) h++hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int+hGetBufNonBlocking h p i = embedHandle "hGetBufNonBlocking" (\h' -> U.hGetBufNonBlocking h' p i) h++#endif++--++openTempFile :: FilePath -> String -> IO (FilePath, Handle) +openTempFile f s = embedPath "openTempFile" (flip U.openTempFile s) f++openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle) +openBinaryTempFile f s = embedPath "openBinaryTempFile" (flip U.openBinaryTempFile s) f+