{-# LANGUAGE OverloadedStrings #-}
module Clod.FileSystem.Operations
(
findAllFiles
, copyFile
, safeRemoveFile
, safeReadFile
, safeWriteFile
, safeCopyFile
) where
import Control.Monad (when)
import Control.Monad.Except (throwError)
import Control.Monad.IO.Class (liftIO)
import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents, removeFile,
copyFile, canonicalizePath)
import System.FilePath ((</>))
import qualified Data.ByteString as BS
import Clod.Types (ClodM, FileReadCap(..), FileWriteCap(..), ClodError(..), isPathAllowed,
allowedReadDirs, allowedWriteDirs, (^.))
findAllFiles :: FilePath -> [FilePath] -> ClodM [FilePath]
findAllFiles :: FilePath -> [FilePath] -> ClodM [FilePath]
findAllFiles FilePath
basePath = ([[FilePath]] -> [FilePath])
-> ReaderT ClodConfig (ExceptT ClodError IO) [[FilePath]]
-> ClodM [FilePath]
forall a b.
(a -> b)
-> ReaderT ClodConfig (ExceptT ClodError IO) a
-> ReaderT ClodConfig (ExceptT ClodError IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ReaderT ClodConfig (ExceptT ClodError IO) [[FilePath]]
-> ClodM [FilePath])
-> ([FilePath]
-> ReaderT ClodConfig (ExceptT ClodError IO) [[FilePath]])
-> [FilePath]
-> ClodM [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> ClodM [FilePath])
-> [FilePath]
-> ReaderT ClodConfig (ExceptT ClodError IO) [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> ClodM [FilePath]
findFilesRecursive
where
findFilesRecursive :: FilePath -> ClodM [FilePath]
findFilesRecursive :: FilePath -> ClodM [FilePath]
findFilesRecursive FilePath
file = do
let useBasePath :: Bool
useBasePath = FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
file Bool -> Bool -> Bool
|| FilePath
file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"."
fullPath :: FilePath
fullPath = if Bool
useBasePath then FilePath
basePath else FilePath
basePath FilePath -> FilePath -> FilePath
</> FilePath
file
isDir <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
fullPath
case isDir of
Bool
False -> [FilePath] -> ClodM [FilePath]
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
file]
Bool
True -> do
contents <- IO [FilePath] -> ClodM [FilePath]
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> ClodM [FilePath])
-> IO [FilePath] -> ClodM [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
fullPath
let validContents = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".", FilePath
".."]) [FilePath]
contents
subFiles <- findAllFiles fullPath validContents
return $ if useBasePath
then subFiles
else map (file </>) subFiles
safeRemoveFile :: FilePath -> ClodM ()
safeRemoveFile :: FilePath -> ClodM ()
safeRemoveFile FilePath
path = do
exists <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path
when exists $ liftIO $ removeFile path
safeReadFile :: FileReadCap -> FilePath -> ClodM BS.ByteString
safeReadFile :: FileReadCap -> FilePath -> ClodM ByteString
safeReadFile FileReadCap
cap FilePath
path = do
allowed <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> IO Bool
isPathAllowed (FileReadCap
cap FileReadCap
-> Getting [FilePath] FileReadCap [FilePath] -> [FilePath]
forall s a. s -> Getting a s a -> a
^. Getting [FilePath] FileReadCap [FilePath]
Lens' FileReadCap [FilePath]
allowedReadDirs) FilePath
path
if allowed
then liftIO $ BS.readFile path
else do
canonicalPath <- liftIO $ canonicalizePath path
throwError $ CapabilityError canonicalPath "Access denied: Cannot read file outside allowed directories"
safeWriteFile :: FileWriteCap -> FilePath -> BS.ByteString -> ClodM ()
safeWriteFile :: FileWriteCap -> FilePath -> ByteString -> ClodM ()
safeWriteFile FileWriteCap
cap FilePath
path ByteString
content = do
allowed <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> IO Bool
isPathAllowed (FileWriteCap
cap FileWriteCap
-> Getting [FilePath] FileWriteCap [FilePath] -> [FilePath]
forall s a. s -> Getting a s a -> a
^. Getting [FilePath] FileWriteCap [FilePath]
Lens' FileWriteCap [FilePath]
allowedWriteDirs) FilePath
path
if allowed
then liftIO $ BS.writeFile path content
else do
canonicalPath <- liftIO $ canonicalizePath path
throwError $ CapabilityError canonicalPath "Access denied: Cannot write file outside allowed directories"
safeCopyFile :: FileReadCap -> FileWriteCap -> FilePath -> FilePath -> ClodM ()
safeCopyFile :: FileReadCap -> FileWriteCap -> FilePath -> FilePath -> ClodM ()
safeCopyFile FileReadCap
readCap FileWriteCap
writeCap FilePath
src FilePath
dest = do
srcAllowed <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> IO Bool
isPathAllowed (FileReadCap
readCap FileReadCap
-> Getting [FilePath] FileReadCap [FilePath] -> [FilePath]
forall s a. s -> Getting a s a -> a
^. Getting [FilePath] FileReadCap [FilePath]
Lens' FileReadCap [FilePath]
allowedReadDirs) FilePath
src
destAllowed <- liftIO $ isPathAllowed (writeCap ^. allowedWriteDirs) dest
if srcAllowed && destAllowed
then liftIO $ copyFile src dest
else do
canonicalSrc <- liftIO $ canonicalizePath src
canonicalDest <- liftIO $ canonicalizePath dest
let (path, errorMsg) = if not srcAllowed && not destAllowed
then (canonicalSrc, "Access denied: Both source and destination paths violate restrictions")
else if not srcAllowed
then (canonicalSrc, "Access denied: Source path violates restrictions")
else (canonicalDest, "Access denied: Destination path violates restrictions")
throwError $ CapabilityError path errorMsg