module Propellor.Property.Gpg where
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import System.PosixCompat
installed :: Property DebianLike
installed :: Property DebianLike
installed = [Package] -> Property DebianLike
Apt.installed [Package
"gnupg"]
newtype GpgKeyId = GpgKeyId { GpgKeyId -> Package
getGpgKeyId :: String }
data GpgKeyType = GpgPubKey | GpgPrivKey
keyImported :: GpgKeyId -> User -> Property (HasInfo + DebianLike)
keyImported :: GpgKeyId -> User -> Property (HasInfo + DebianLike)
keyImported key :: GpgKeyId
key@(GpgKeyId Package
keyid) user :: User
user@(User Package
u) = Property (HasInfo + DebianLike)
prop
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
where
desc :: Package
desc = Package
u forall a. [a] -> [a] -> [a]
++ Package
" has gpg key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Package
show Package
keyid
prop :: Property (HasInfo + DebianLike)
prop :: Property (HasInfo + DebianLike)
prop = forall c s metatypes.
(IsContext c, IsPrivDataSource s,
IncludesInfo metatypes ~ 'True) =>
s
-> c
-> (((PrivData -> Propellor Result) -> Propellor Result)
-> Property metatypes)
-> Property metatypes
withPrivData PrivDataSource
src (Package -> Context
Context Package
keyid) forall a b. (a -> b) -> a -> b
$ \(PrivData -> Propellor Result) -> Propellor Result
getkey ->
forall {k} (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property Package
desc forall a b. (a -> b) -> a -> b
$ (PrivData -> Propellor Result) -> Propellor Result
getkey forall a b. (a -> b) -> a -> b
$ \PrivData
key' -> do
let keylines :: [Package]
keylines = PrivData -> [Package]
privDataLines PrivData
key'
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe GpgKeyType -> IO Bool
hasGpgKey ([Package] -> Maybe GpgKeyType
parse [Package]
keylines))
( forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
, IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ forall a.
StdHandle
-> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a
withHandle StdHandle
StdinHandle CreateProcessRunner
createProcessSuccess
(Package -> [Package] -> CreateProcess
proc Package
"su" [Package
"--login", Package
"-c", Package
"gpg --import", Package
u]) forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
Handle -> Package -> IO ()
hPutStr Handle
h ([Package] -> Package
unlines [Package]
keylines)
Handle -> IO ()
hClose Handle
h
)
src :: PrivDataSource
src = PrivDataField -> Package -> PrivDataSource
PrivDataSource PrivDataField
GpgKey Package
"Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a"
parse :: [Package] -> Maybe GpgKeyType
parse (Package
"-----BEGIN PGP PUBLIC KEY BLOCK-----":[Package]
_) = forall a. a -> Maybe a
Just GpgKeyType
GpgPubKey
parse (Package
"-----BEGIN PGP PRIVATE KEY BLOCK-----":[Package]
_) = forall a. a -> Maybe a
Just GpgKeyType
GpgPrivKey
parse [Package]
_ = forall a. Maybe a
Nothing
hasGpgKey :: Maybe GpgKeyType -> IO Bool
hasGpgKey Maybe GpgKeyType
Nothing = forall a. HasCallStack => Package -> a
error forall a b. (a -> b) -> a -> b
$ Package
"Failed to run gpg parser on armored key " forall a. [a] -> [a] -> [a]
++ Package
keyid
hasGpgKey (Just GpgKeyType
GpgPubKey) = GpgKeyId -> User -> IO Bool
hasPubKey GpgKeyId
key User
user
hasGpgKey (Just GpgKeyType
GpgPrivKey) = GpgKeyId -> User -> IO Bool
hasPrivKey GpgKeyId
key User
user
hasPrivKey :: GpgKeyId -> User -> IO Bool
hasPrivKey :: GpgKeyId -> User -> IO Bool
hasPrivKey (GpgKeyId Package
keyid) (User Package
u) = forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
catchBoolIO forall a b. (a -> b) -> a -> b
$
forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> [Package] -> Maybe Package -> IO (Package, Bool)
processTranscript Package
"su" [Package
"--login", Package
"-c", Package
"gpg --list-secret-keys " forall a. [a] -> [a] -> [a]
++ Package -> Package
shellEscape Package
keyid, Package
u] forall a. Maybe a
Nothing
hasPubKey :: GpgKeyId -> User -> IO Bool
hasPubKey :: GpgKeyId -> User -> IO Bool
hasPubKey (GpgKeyId Package
keyid) (User Package
u) = forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
catchBoolIO forall a b. (a -> b) -> a -> b
$
forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> [Package] -> Maybe Package -> IO (Package, Bool)
processTranscript Package
"su" [Package
"--login", Package
"-c", Package
"gpg --list-public-keys " forall a. [a] -> [a] -> [a]
++ Package -> Package
shellEscape Package
keyid, Package
u] forall a. Maybe a
Nothing
dotDir :: User -> IO FilePath
dotDir :: User -> IO Package
dotDir (User Package
u) = do
Package
home <- UserEntry -> Package
homeDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> IO UserEntry
getUserEntryForName Package
u
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Package
home Package -> Package -> Package
</> Package
".gnupg"