diff options
Diffstat (limited to 'src/Propellor/Property/File.hs')
-rw-r--r-- | src/Propellor/Property/File.hs | 120 |
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. |