summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/File.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/File.hs')
-rw-r--r--src/Propellor/Property/File.hs120
1 files changed, 73 insertions, 47 deletions
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index e072fcaa..95fc6f81 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -1,8 +1,11 @@
+{-# LANGUAGE FlexibleInstances #-}
+
module Propellor.Property.File where
import Propellor.Base
import Utility.FileMode
+import qualified Data.ByteString.Lazy as L
import System.Posix.Files
import System.Exit
@@ -14,10 +17,28 @@ f `hasContent` newcontent = fileProperty
("replace " ++ f)
(\_oldcontent -> newcontent) f
+-- | Ensures that a line is present in a file, adding it to the end if not.
+containsLine :: FilePath -> Line -> Property UnixLike
+f `containsLine` l = f `containsLines` [l]
+
+containsLines :: FilePath -> [Line] -> Property UnixLike
+f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
+ where
+ go content = content ++ filter (`notElem` content) ls
+
+-- | Ensures that a line is not present in a file.
+-- Note that the file is ensured to exist, so if it doesn't, an empty
+-- file will be written.
+lacksLine :: FilePath -> Line -> Property UnixLike
+f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
+
+lacksLines :: FilePath -> [Line] -> Property UnixLike
+f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f
+
-- | Replaces all the content of a file, ensuring that its modes do not
-- allow it to be read or written by anyone other than the current user
hasContentProtected :: FilePath -> [Line] -> Property UnixLike
-f `hasContentProtected` newcontent = fileProperty' writeFileProtected
+f `hasContentProtected` newcontent = fileProperty' ProtectedWrite
("replace " ++ f)
(\_oldcontent -> newcontent) f
@@ -29,9 +50,9 @@ hasPrivContent :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent f = hasPrivContentFrom (PrivDataSourceFile (PrivFile f) f) f
-- | Like hasPrivContent, but allows specifying a source
--- for PrivData, rather than using PrivDataSourceFile .
+-- for PrivData, rather than using `PrivDataSourceFile`.
hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
-hasPrivContentFrom = hasPrivContent' writeFileProtected
+hasPrivContentFrom = hasPrivContent' ProtectedWrite
-- | Leaves the file at its default or current mode,
-- allowing "private" data to be read.
@@ -41,68 +62,30 @@ hasPrivContentExposed :: IsContext c => FilePath -> c -> Property (HasInfo + Uni
hasPrivContentExposed f = hasPrivContentExposedFrom (PrivDataSourceFile (PrivFile f) f) f
hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
-hasPrivContentExposedFrom = hasPrivContent' writeFile
+hasPrivContentExposedFrom = hasPrivContent' NormalWrite
-hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
-hasPrivContent' writer source f context =
+hasPrivContent' :: (IsContext c, IsPrivDataSource s) => FileWriteMode -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
+hasPrivContent' writemode source f context =
withPrivData source context $ \getcontent ->
property' desc $ \o -> getcontent $ \privcontent ->
- ensureProperty o $ fileProperty' writer desc
- (\_oldcontent -> privDataLines privcontent) f
+ ensureProperty o $ fileProperty' writemode desc
+ (\_oldcontent -> privDataByteString privcontent) f
where
desc = "privcontent " ++ f
--- | Ensures that a line is present in a file, adding it to the end if not.
-containsLine :: FilePath -> Line -> Property UnixLike
-f `containsLine` l = f `containsLines` [l]
-
-containsLines :: FilePath -> [Line] -> Property UnixLike
-f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
- where
- go content = content ++ filter (`notElem` content) ls
-
--- | Ensures that a line is not present in a file.
--- Note that the file is ensured to exist, so if it doesn't, an empty
--- file will be written.
-lacksLine :: FilePath -> Line -> Property UnixLike
-f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
-
-lacksLines :: FilePath -> [Line] -> Property UnixLike
-f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f
-
-- | Replaces the content of a file with the transformed content of another file
basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike
f `basedOn` (f', a) = property' desc $ \o -> do
tmpl <- liftIO $ readFile f'
ensureProperty o $ fileProperty desc (\_ -> a $ lines $ tmpl) f
where
- desc = "replace " ++ f
+ desc = f ++ " is based on " ++ f'
-- | Removes a file. Does not remove symlinks or non-plain-files.
notPresent :: FilePath -> Property UnixLike
notPresent f = check (doesFileExist f) $ property (f ++ " not present") $
makeChange $ nukeFile f
-fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike
-fileProperty = fileProperty' writeFile
-fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike
-fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
- where
- go True = do
- old <- liftIO $ readFile f
- let new = unlines (a (lines old))
- if old == new
- then noChange
- else makeChange $ updatefile new `viaStableTmp` f
- go False = makeChange $ writer f (unlines $ a [])
-
- -- Replicate the original file's owner and mode.
- updatefile content f' = do
- writer f' content
- s <- getFileStatus f
- setFileMode f' (fileMode s)
- setOwnerAndGroup f' (fileOwner s) (fileGroup s)
-
-- | Ensures a directory exists.
dirExists :: FilePath -> Property UnixLike
dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $
@@ -172,6 +155,49 @@ mode f v = p `changesFile` f
liftIO $ modifyFileMode f (const v)
return NoChange
+class FileContent c where
+ emptyFileContent :: c
+ readFileContent :: FilePath -> IO c
+ writeFileContent :: FileWriteMode -> FilePath -> c -> IO ()
+
+data FileWriteMode = NormalWrite | ProtectedWrite
+
+instance FileContent [Line] where
+ emptyFileContent = []
+ readFileContent f = lines <$> readFile f
+ writeFileContent NormalWrite f ls = writeFile f (unlines ls)
+ writeFileContent ProtectedWrite f ls = writeFileProtected f (unlines ls)
+
+instance FileContent L.ByteString where
+ emptyFileContent = L.empty
+ readFileContent = L.readFile
+ writeFileContent NormalWrite f c = L.writeFile f c
+ writeFileContent ProtectedWrite f c =
+ writeFileProtected' f (`L.hPutStr` c)
+
+-- | A property that applies a pure function to the content of a file.
+fileProperty :: (FileContent c, Eq c) => Desc -> (c -> c) -> FilePath -> Property UnixLike
+fileProperty = fileProperty' NormalWrite
+fileProperty' :: (FileContent c, Eq c) => FileWriteMode -> Desc -> (c -> c) -> FilePath -> Property UnixLike
+fileProperty' writemode desc a f = property desc $ go =<< liftIO (doesFileExist f)
+ where
+ go True = do
+ old <- liftIO $ readFileContent f
+ let new = a old
+ if old == new
+ then noChange
+ else makeChange $ updatefile new `viaStableTmp` f
+ go False = makeChange $ writer f (a emptyFileContent)
+
+ -- Replicate the original file's owner and mode.
+ updatefile content dest = do
+ writer dest content
+ s <- getFileStatus f
+ setFileMode dest (fileMode s)
+ setOwnerAndGroup dest (fileOwner s) (fileGroup s)
+
+ writer = writeFileContent writemode
+
-- | A temp file to use when writing new content for a file.
--
-- This is a stable name so it can be removed idempotently.