From 0f623044f485121e39a6389bb1511f9afb40cd20 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Mar 2014 19:11:24 -0400 Subject: [PATCH] propellor spin --- PrivData.hs | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) create mode 100644 PrivData.hs diff --git a/PrivData.hs b/PrivData.hs new file mode 100644 index 0000000..c0c07fb --- /dev/null +++ b/PrivData.hs @@ -0,0 +1,76 @@ +module PrivData where + +import qualified Data.Map as M +import Control.Applicative +import System.FilePath +import System.IO +import System.Directory +import Data.Maybe +import Control.Monad + +import Types +import Utility.Monad +import Utility.PartialPrelude +import Utility.Exception +import Utility.Process +import Utility.Tmp +import Utility.SafeCommand + +{- Note that removing or changing field names will break the + - serialized privdata files, so don't do that! + - It's fine to add new fields. -} +data PrivDataField + = DockerAuthentication + | SshPrivKey UserName + | Password UserName + deriving (Read, Show, Ord, Eq) + +withPrivData :: PrivDataField -> (String -> IO Result) -> IO Result +withPrivData field a = maybe missing a =<< getPrivData field + where + missing = do + hPutStrLn stderr $ "** Missing privdata " ++ 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 -> String -> IO () +setPrivData host field value = do + let f = privDataFile host + m <- fromMaybe M.empty . readish <$> gpgDecrypt f + let m' = M.insert field value m + gpgEncrypt f (show m') + void $ boolSystem "git" [Param "add", File f] + +privDataDir :: FilePath +privDataDir = "privdata" + +privDataFile :: HostName -> FilePath +privDataFile host = privDataDir host ++ ".gpg" + +privDataLocal :: FilePath +privDataLocal = privDataDir "local" + +privDataMarker :: String +privDataMarker = "PRIVDATA " + +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