From 0d93f4f12c4c7d0a37dc2e6f792ce0f9dde793db Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 14 Sep 2015 21:49:05 -0400 Subject: Allow storing arbitrary ByteStrings in PrivData, extracted using privDataByteString. --- src/Propellor/Gpg.hs | 10 ++++++---- src/Propellor/PrivData.hs | 13 ++++++++----- src/Propellor/Types/PrivData.hs | 6 ++++++ src/Utility/FileSystemEncoding.hs | 19 +++++++++++++++++-- src/Utility/Process.hs | 2 ++ 5 files changed, 39 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs index 86f84dc1..24743d40 100644 --- a/src/Propellor/Gpg.hs +++ b/src/Propellor/Gpg.hs @@ -14,6 +14,7 @@ import Utility.Process import Utility.Monad import Utility.Misc import Utility.Tmp +import Utility.FileSystemEncoding type KeyId = String @@ -112,8 +113,9 @@ gpgEncrypt f s = do , "--encrypt" , "--trust-model", "always" ] ++ concatMap (\k -> ["--recipient", k]) keyids - encrypted <- writeReadProcessEnv "gpg" opts - Nothing - (Just $ flip hPutStr s) - Nothing + encrypted <- writeReadProcessEnv "gpg" opts Nothing (Just writer) Nothing viaTmp writeFile f encrypted + where + writer h = do + fileEncoding h + hPutStr h s diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index b7932518..a28fb195 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -31,6 +31,7 @@ import Control.Monad.IfElse import "mtl" Control.Monad.Reader import qualified Data.Map as M import qualified Data.Set as S +import qualified Data.ByteString.Lazy as L import Propellor.Types import Propellor.Types.PrivData @@ -48,6 +49,7 @@ import Utility.Misc import Utility.FileMode import Utility.Env import Utility.Table +import Utility.FileSystemEncoding -- | Allows a Property to access the value of a specific PrivDataField, -- for use in a specific Context or HostContext. @@ -149,6 +151,7 @@ getPrivData field context m = do setPrivData :: PrivDataField -> Context -> IO () setPrivData field context = do putStrLn "Enter private data on stdin; ctrl-D when done:" + fileEncoding stdin setPrivDataTo field context . PrivData =<< hGetContentsStrict stdin unsetPrivData :: PrivDataField -> Context -> IO () @@ -157,17 +160,17 @@ unsetPrivData field context = do putStrLn "Private data unset." dumpPrivData :: PrivDataField -> Context -> IO () -dumpPrivData field context = +dumpPrivData field context = do maybe (error "Requested privdata is not set.") - (mapM_ putStrLn . privDataLines) + (L.hPut stdout . privDataByteString) =<< (getPrivData field context <$> decryptPrivData) editPrivData :: PrivDataField -> Context -> IO () editPrivData field context = do v <- getPrivData field context <$> decryptPrivData - v' <- withTmpFile "propellorXXXX" $ \f h -> do - hClose h - maybe noop (writeFileProtected f . unlines . privDataLines) v + v' <- withTmpFile "propellorXXXX" $ \f th -> do + hClose th + maybe noop (\p -> writeFileProtected' f (`L.hPut` privDataByteString p)) v editor <- getEnvDefault "EDITOR" "vi" unlessM (boolSystem editor [File f]) $ error "Editor failed; aborting." diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs index c72838cb..98cdb7a1 100644 --- a/src/Propellor/Types/PrivData.hs +++ b/src/Propellor/Types/PrivData.hs @@ -2,8 +2,10 @@ module Propellor.Types.PrivData where import Propellor.Types.OS import Utility.PartialPrelude +import Utility.FileSystemEncoding import Data.Maybe +import qualified Data.ByteString.Lazy as L -- | Note that removing or changing constructors or changing types will -- break the serialized privdata files, so don't do that! @@ -110,6 +112,10 @@ privDataLines (PrivData s) = lines s privDataVal :: PrivData -> String privDataVal (PrivData s) = fromMaybe "" (headMaybe (lines s)) +-- | Use to get ByteString out of PrivData. +privDataByteString :: PrivData -> L.ByteString +privDataByteString (PrivData s) = encodeBS s + data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519 deriving (Read, Show, Ord, Eq, Enum, Bounded) diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs index 41c5972a..2d9691d5 100644 --- a/src/Utility/FileSystemEncoding.hs +++ b/src/Utility/FileSystemEncoding.hs @@ -13,6 +13,7 @@ module Utility.FileSystemEncoding ( withFilePath, md5FilePath, decodeBS, + encodeBS, decodeW8, encodeW8, encodeW8NUL, @@ -34,6 +35,8 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.UTF8 as L8 #endif +import Utility.Exception + {- Sets a Handle to use the filesystem encoding. This causes data - written or read from it to be encoded/decoded the same - as ghc 7.4 does to filenames etc. This special encoding @@ -67,12 +70,16 @@ withFilePath fp f = Encoding.getFileSystemEncoding - only allows doing this conversion with CStrings, and the CString buffer - is allocated, used, and deallocated within the call, with no side - effects. + - + - If the FilePath contains a value that is not legal in the filesystem + - encoding, rather than thowing an exception, it will be returned as-is. -} {-# NOINLINE _encodeFilePath #-} _encodeFilePath :: FilePath -> String _encodeFilePath fp = unsafePerformIO $ do enc <- Encoding.getFileSystemEncoding - GHC.withCString enc fp $ GHC.peekCString Encoding.char8 + GHC.withCString enc fp (GHC.peekCString Encoding.char8) + `catchNonAsync` (\_ -> return fp) {- Encodes a FilePath into a Md5.Str, applying the filesystem encoding. -} md5FilePath :: FilePath -> MD5.Str @@ -81,13 +88,21 @@ md5FilePath = MD5.Str . _encodeFilePath {- Decodes a ByteString into a FilePath, applying the filesystem encoding. -} decodeBS :: L.ByteString -> FilePath #ifndef mingw32_HOST_OS -decodeBS = encodeW8 . L.unpack +decodeBS = encodeW8NUL . L.unpack #else {- On Windows, we assume that the ByteString is utf-8, since Windows - only uses unicode for filenames. -} decodeBS = L8.toString #endif +{- Encodes a FilePath into a ByteString, applying the filesystem encoding. -} +encodeBS :: FilePath -> L.ByteString +#ifndef mingw32_HOST_OS +encodeBS = L.pack . decodeW8NUL +#else +encodeBS = L8.fromString +#endif + {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding. - - w82c produces a String, which may contain Chars that are invalid diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs index c4882a01..05205de8 100644 --- a/src/Utility/Process.hs +++ b/src/Utility/Process.hs @@ -60,6 +60,7 @@ import Prelude import Utility.Misc import Utility.Exception +import Utility.FileSystemEncoding type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a @@ -81,6 +82,7 @@ readProcessEnv cmd args environ = readProcess' p readProcess' :: CreateProcess -> IO String readProcess' p = withHandle StdoutHandle createProcessSuccess p $ \h -> do + fileEncoding h output <- hGetContentsStrict h hClose h return output -- cgit v1.2.3