143 lines
4.4 KiB
Haskell
143 lines
4.4 KiB
Haskell
{-# 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 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 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
|
|
|
|
-- | 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.
|
|
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) } }
|
|
|
|
{- 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
|
|
|
|
getPrivData :: PrivDataField -> Context -> (M.Map (PrivDataField, Context) PrivData) -> 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 :: IO ()
|
|
listPrivDataFields = do
|
|
m <- decryptPrivData
|
|
putStrLn ("\nAll currently set privdata fields:")
|
|
mapM_ list $ M.keys m
|
|
where
|
|
list = putStrLn . ("\t" ++) . shellEscape . show
|
|
|
|
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 (M.Map (PrivDataField, Context) PrivData)
|
|
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
|