split out gpg keyring related stuff

This commit is contained in:
Joey Hess 2014-11-11 12:32:17 -04:00
parent bd856f7a04
commit 347c02a38e
3 changed files with 48 additions and 42 deletions

View File

@ -113,6 +113,7 @@ Library
Other-Modules:
Propellor.Types.Info
Propellor.CmdLine
Propellor.Keyring
Propellor.SimpleSh
Propellor.Property.Docker.Shim
Utility.Applicative

View File

@ -13,6 +13,7 @@ import System.Posix.IO
import Data.Time.Clock.POSIX
import Propellor
import Propellor.Keyring
import qualified Propellor.Property.Docker as Docker
import qualified Propellor.Property.Docker.Shim as DockerShim
import Utility.FileMode
@ -303,48 +304,6 @@ boot h = do
fromMarked privDataMarker reply
mainProperties h
addKey :: String -> IO ()
addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitconfig, gitcommit ]
where
gpg = do
createDirectoryIfMissing True privDataDir
boolSystem "sh"
[ Param "-c"
, Param $ "gpg --export " ++ keyid ++ " | gpg " ++
unwords (gpgopts ++ ["--import"])
]
gitadd = boolSystem "git"
[ Param "add"
, File keyring
]
gitconfig = boolSystem "git"
[ Param "config"
, Param "user.signingkey"
, Param keyid
]
gitcommit = gitCommit
[ File keyring
, Param "-m"
, Param "propellor addkey"
]
{- Automatically sign the commit if there'a a keyring. -}
gitCommit :: [CommandParam] -> IO Bool
gitCommit ps = do
k <- doesFileExist keyring
boolSystem "git" $ catMaybes $
[ Just (Param "commit")
, if k then Just (Param "--gpg-sign") else Nothing
] ++ map Just ps
keyring :: FilePath
keyring = privDataDir </> "keyring.gpg"
gpgopts :: [String]
gpgopts = ["--options", "/dev/null", "--no-default-keyring", "--keyring", keyring]
getUrl :: IO String
getUrl = maybe nourl return =<< getM get urls
where

46
src/Propellor/Keyring.hs Normal file
View File

@ -0,0 +1,46 @@
module Propellor.Keyring where
import Propellor
import Utility.SafeCommand
addKey :: String -> IO ()
addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitconfig, gitcommit ]
where
gpg = do
createDirectoryIfMissing True privDataDir
boolSystem "sh"
[ Param "-c"
, Param $ "gpg --export " ++ keyid ++ " | gpg " ++
unwords (gpgopts ++ ["--import"])
]
gitadd = boolSystem "git"
[ Param "add"
, File keyring
]
gitconfig = boolSystem "git"
[ Param "config"
, Param "user.signingkey"
, Param keyid
]
gitcommit = gitCommit
[ File keyring
, Param "-m"
, Param "propellor addkey"
]
{- Automatically sign the commit if there'a a keyring. -}
gitCommit :: [CommandParam] -> IO Bool
gitCommit ps = do
k <- doesFileExist keyring
boolSystem "git" $ catMaybes $
[ Just (Param "commit")
, if k then Just (Param "--gpg-sign") else Nothing
] ++ map Just ps
keyring :: FilePath
keyring = privDataDir </> "keyring.gpg"
gpgopts :: [String]
gpgopts = ["--options", "/dev/null", "--no-default-keyring", "--keyring", keyring]