propellor (0.8.1) unstable; urgency=medium

  * Run apt-get update in initial bootstrap.
  * --list-fields now includes a table of fields that are not currently set,
    but would be used if they got set.
  * Remove .gitignore from cabal file list, to avoid build failure on Debian.
    Closes: #754334

# imported from the archive

1 files changed, 175 insertions, 0 deletions

diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
new file mode 100644
index 00000000..f85ded15
--- /dev/null
+++ b/src/Propellor/PrivData.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE PackageImports #-}
+
+module Propellor.PrivData where
+
+import Control.Applicative
+import System.FilePath
+import System.IO
+import System.Directory
+import Data.Maybe
+import Data.Monoid
+import Data.List
+import Control.Monad
+import Control.Monad.IfElse
+import "mtl" Control.Monad.Reader
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+import Propellor.Types
+import Propellor.Types.Info
+import Propellor.Message
+import Propellor.Info
+import Utility.Monad
+import Utility.PartialPrelude
+import Utility.Exception
+import Utility.Process
+import Utility.Tmp
+import Utility.SafeCommand
+import Utility.Misc
+import Utility.FileMode
+import Utility.Env
+import Utility.Table
+
+-- | Allows a Property to access the value of a specific PrivDataField,
+-- for use in a specific Context.
+--
+-- Example use:
+--
+-- > withPrivData (PrivFile pemfile) (Context "joeyh.name") $ \getdata ->
+-- >     property "joeyh.name ssl cert" $ getdata $ \privdata ->
+-- >       liftIO $ writeFile pemfile privdata
+-- >   where pemfile = "/etc/ssl/certs/web.pem"
+-- 
+-- Note that if the value is not available, the action is not run
+-- and instead it prints a message to help the user make the necessary
+-- private data available.
+--
+-- The resulting Property includes Info about the PrivDataField
+-- being used, which is necessary to ensure that the privdata is sent to
+-- the remote host by propellor.
+withPrivData
+	:: PrivDataField
+	-> Context
+	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
+	-> Property
+withPrivData field context@(Context cname) mkprop = addinfo $ mkprop $ \a ->
+	maybe missing a =<< liftIO (getLocalPrivData field context)
+  where
+	missing = liftIO $ do
+		warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")"
+		putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'"
+		return FailedChange
+	addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, context) } }
+
+addPrivDataField :: (PrivDataField, Context) -> Property
+addPrivDataField v = pureInfoProperty (show v) $
+	mempty { _privDataFields = S.singleton v }
+
+{- Gets the requested field's value, in the specified context if it's
+ - available, from the host's local privdata cache. -}
+getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData)
+getLocalPrivData field context =
+	getPrivData field context . fromMaybe M.empty <$> localcache
+  where
+	localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal
+
+type PrivMap = M.Map (PrivDataField, Context) PrivData
+
+{- Get only the set of PrivData that the Host's Info says it uses. -}
+filterPrivData :: Host -> PrivMap -> PrivMap
+filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
+  where
+	used = _privDataFields $ hostInfo host
+
+getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
+getPrivData field context = M.lookup (field, context)
+
+setPrivData :: PrivDataField -> Context -> IO ()
+setPrivData field context = do
+	putStrLn "Enter private data on stdin; ctrl-D when done:"
+	setPrivDataTo field context =<< hGetContentsStrict stdin
+
+dumpPrivData :: PrivDataField -> Context -> IO ()
+dumpPrivData field context =
+	maybe (error "Requested privdata is not set.") putStrLn
+		=<< (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) v
+		editor <- getEnvDefault "EDITOR" "vi"
+		unlessM (boolSystem editor [File f]) $
+			error "Editor failed; aborting."
+		readFile f
+	setPrivDataTo field context v'
+
+listPrivDataFields :: [Host] -> IO ()
+listPrivDataFields hosts = do
+	m <- decryptPrivData
+	showtable "Currently set data:" $
+		map mkrow (M.keys m)
+	showtable "Data that would be used if set:" $
+		map mkrow (M.keys $ M.difference wantedmap m)
+  where
+  	header = ["Field", "Context", "Used by"]
+	mkrow k@(field, (Context context)) =
+		[ shellEscape $ show field
+		, shellEscape context
+		, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby
+		]
+	mkhostmap host = M.fromList $ map (\k -> (k, [hostName host])) $
+		S.toList $ _privDataFields $ hostInfo host
+	usedby = M.unionsWith (++) $ map mkhostmap hosts
+	wantedmap = M.fromList $ zip (M.keys usedby) (repeat "")
+	showtable desc rows = do
+		putStrLn $ "\n" ++ desc
+		putStr $ unlines $ formatTable $ tableWithHeader header rows
+
+setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
+setPrivDataTo field context value = do
+	makePrivDataDir
+	m <- decryptPrivData
+	let m' = M.insert (field, context) (chomp value) m
+	gpgEncrypt privDataFile (show m')
+	putStrLn "Private data set."
+	void $ boolSystem "git" [Param "add", File privDataFile]
+  where
+	chomp s
+		| end s == "\n" = chomp (beginning s)
+		| otherwise = s
+
+decryptPrivData :: IO PrivMap
+decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile
+
+makePrivDataDir :: IO ()
+makePrivDataDir = createDirectoryIfMissing False privDataDir
+
+privDataDir :: FilePath
+privDataDir = "privdata"
+
+privDataFile :: FilePath
+privDataFile = privDataDir </> "privdata.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