From 82da31b3e0e9acdfbca4c48eb12ab1f28515ba10 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 9 Jul 2014 22:11:31 -0400 Subject: 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 --- src/Propellor/PrivData.hs | 175 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 175 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..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 -- cgit v1.3-2-g0d8e