From 7115d1ec162b4059b3e8e8f84bd8d5898c1db025 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 14 May 2014 19:41:05 -0400 Subject: moved source code to src This is to work around OSX's brain-damange regarding filename case insensitivity. Avoided moving config.hs, because it's a config file. Put in a symlink to make build work. --- src/Propellor/PrivData.hs | 91 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 91 insertions(+) create mode 100644 src/Propellor/PrivData.hs (limited to 'src/Propellor/PrivData.hs') diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs new file mode 100644 index 00000000..ad2c8d22 --- /dev/null +++ b/src/Propellor/PrivData.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE PackageImports #-} + +module Propellor.PrivData where + +import qualified Data.Map as M +import Control.Applicative +import System.FilePath +import System.IO +import System.Directory +import Data.Maybe +import Data.List +import Control.Monad +import "mtl" Control.Monad.Reader + +import Propellor.Types +import Propellor.Attr +import Propellor.Message +import Utility.Monad +import Utility.PartialPrelude +import Utility.Exception +import Utility.Process +import Utility.Tmp +import Utility.SafeCommand +import Utility.Misc + +-- | When the specified PrivDataField is available on the host Propellor +-- is provisioning, it provies the data to the action. Otherwise, it prints +-- a message to help the user make the necessary private data available. +withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Result +withPrivData field a = maybe missing a =<< liftIO (getPrivData field) + where + missing = do + host <- getHostName + let host' = if ".docker" `isSuffixOf` host + then "$parent_host" + else host + liftIO $ do + warningMessage $ "Missing privdata " ++ show field + putStrLn $ "Fix this by running: propellor --set "++host'++" '" ++ show field ++ "'" + return FailedChange + +getPrivData :: PrivDataField -> IO (Maybe String) +getPrivData field = do + m <- catchDefaultIO Nothing $ readish <$> readFile privDataLocal + return $ maybe Nothing (M.lookup field) m + +setPrivData :: HostName -> PrivDataField -> IO () +setPrivData host field = do + putStrLn "Enter private data on stdin; ctrl-D when done:" + value <- chomp <$> hGetContentsStrict stdin + makePrivDataDir + let f = privDataFile host + m <- fromMaybe M.empty . readish <$> gpgDecrypt f + let m' = M.insert field value m + gpgEncrypt f (show m') + putStrLn "Private data set." + void $ boolSystem "git" [Param "add", File f] + where + chomp s + | end s == "\n" = chomp (beginning s) + | otherwise = s + +makePrivDataDir :: IO () +makePrivDataDir = createDirectoryIfMissing False privDataDir + +privDataDir :: FilePath +privDataDir = "privdata" + +privDataFile :: HostName -> FilePath +privDataFile host = privDataDir host ++ ".gpg" + +privDataLocal :: FilePath +privDataLocal = privDataDir "local" + +gpgDecrypt :: FilePath -> IO String +gpgDecrypt f = ifM (doesFileExist f) + ( readProcess "gpg" ["--decrypt", f] + , return "" + ) + +gpgEncrypt :: FilePath -> String -> IO () +gpgEncrypt f s = do + encrypted <- writeReadProcessEnv "gpg" + [ "--default-recipient-self" + , "--armor" + , "--encrypt" + ] + Nothing + (Just $ flip hPutStr s) + Nothing + viaTmp writeFile f encrypted -- cgit v1.2.3