propellor spin
This commit is contained in:
parent
61d8214d9d
commit
0f623044f4
|
@ -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
|
Loading…
Reference in New Issue