summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Schurman2016-06-12 23:57:08 -0700
committerJoey Hess2016-06-19 13:19:48 -0400
commit6589837d4c3e7c93d13bb778fccbb1b71cfe2b51 (patch)
treeab395fe303f278c194760f9854895a9b90ee254b
parent0e3d258f46e366e01abf28e173ef8fb7adf5a6dd (diff)
Write privdata files in binary rather than text
https://propellor.branchable.com/todo/bytes_in_privData__63__/
-rw-r--r--src/Propellor/Property/File.hs33
-rw-r--r--src/Utility/FileMode.hs5
2 files changed, 32 insertions, 6 deletions
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index e072fcaa..8bf97948 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -3,6 +3,7 @@ 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
@@ -17,7 +18,7 @@ f `hasContent` newcontent = fileProperty
-- | 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' writeFileProtected
("replace " ++ f)
(\_oldcontent -> newcontent) f
@@ -31,7 +32,7 @@ hasPrivContent f = hasPrivContentFrom (PrivDataSourceFile (PrivFile f) f) f
-- | Like hasPrivContent, but allows specifying a source
-- for PrivData, rather than using PrivDataSourceFile .
hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
-hasPrivContentFrom = hasPrivContent' writeFileProtected
+hasPrivContentFrom = hasPrivContent' writeBytesProtected
-- | Leaves the file at its default or current mode,
-- allowing "private" data to be read.
@@ -41,14 +42,14 @@ 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' L.writeFile
-hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
+hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> L.ByteString -> IO ()) -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent' writer source f context =
withPrivData source context $ \getcontent ->
property' desc $ \o -> getcontent $ \privcontent ->
- ensureProperty o $ fileProperty' writer desc
- (\_oldcontent -> privDataLines privcontent) f
+ ensureProperty o $ bytesProperty' writer desc
+ (\_oldcontent -> privDataByteString privcontent) f
where
desc = "privcontent " ++ f
@@ -103,6 +104,26 @@ fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
setFileMode f' (fileMode s)
setOwnerAndGroup f' (fileOwner s) (fileGroup s)
+bytesProperty :: Desc -> (L.ByteString -> L.ByteString) -> FilePath -> Property UnixLike
+bytesProperty = bytesProperty' L.writeFile
+bytesProperty' :: (FilePath -> L.ByteString -> IO ()) -> Desc -> (L.ByteString -> L.ByteString) -> FilePath -> Property UnixLike
+bytesProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
+ where
+ go True = do
+ old <- liftIO $ L.readFile f
+ let new = a old
+ if old == new
+ then noChange
+ else makeChange $ updatefile new `viaStableTmp` f
+ go False = makeChange $ writer f $ a L.empty
+
+ -- 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") $
diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs
index bb3780c6..3068d55a 100644
--- a/src/Utility/FileMode.hs
+++ b/src/Utility/FileMode.hs
@@ -13,6 +13,7 @@ module Utility.FileMode (
) where
import System.IO
+import qualified Data.ByteString.Lazy as L
import Control.Monad
import System.PosixCompat.Types
import Utility.PosixFiles
@@ -166,3 +167,7 @@ writeFileProtected' file writer = withUmask 0o0077 $
withFile file WriteMode $ \h -> do
void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
writer h
+
+writeBytesProtected :: FilePath -> L.ByteString -> IO ()
+writeBytesProtected file content = writeFileProtected' file
+ (`L.hPutStr` content)