propellor

propellor config for hosts.
git clone git://git.ricketyspace.net/propellor.git
Log | Files | Refs | LICENSE

Gpg.hs (2409B)


      1 module Propellor.Property.Gpg where
      2 
      3 import Propellor.Base
      4 import qualified Propellor.Property.Apt as Apt
      5 
      6 import System.PosixCompat
      7 
      8 installed :: Property DebianLike
      9 installed = Apt.installed ["gnupg"]
     10 
     11 -- A numeric id, or a description of the key, in a form understood by gpg.
     12 newtype GpgKeyId = GpgKeyId { getGpgKeyId :: String }
     13 
     14 data GpgKeyType = GpgPubKey | GpgPrivKey
     15 
     16 -- | Sets up a user with a gpg key from the privdata.
     17 --
     18 -- Note that if a secret key is exported using gpg -a --export-secret-key,
     19 -- the public key is also included. Or just a public key could be
     20 -- exported, and this would set it up just as well.
     21 --
     22 -- Recommend only using this for low-value dedicated role keys.
     23 -- No attempt has been made to scrub the key out of memory once it's used.
     24 keyImported :: GpgKeyId -> User -> Property (HasInfo + DebianLike)
     25 keyImported key@(GpgKeyId keyid) user@(User u) = prop
     26 	`requires` installed
     27   where
     28 	desc = u ++ " has gpg key " ++ show keyid
     29 	prop :: Property (HasInfo + DebianLike)
     30 	prop = withPrivData src (Context keyid) $ \getkey ->
     31 		property desc $ getkey $ \key' -> do
     32 			let keylines = privDataLines key'
     33 			ifM (liftIO $ hasGpgKey (parse keylines))
     34 				( return NoChange
     35 				, makeChange $ withHandle StdinHandle createProcessSuccess
     36 					(proc "su" ["--login", "-c", "gpg --import", u]) $ \h -> do
     37 						hPutStr h (unlines keylines)
     38 						hClose h
     39 				)
     40 	src = PrivDataSource GpgKey "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a"
     41 
     42 	parse ("-----BEGIN PGP PUBLIC KEY BLOCK-----":_) = Just GpgPubKey
     43 	parse ("-----BEGIN PGP PRIVATE KEY BLOCK-----":_) = Just GpgPrivKey
     44 	parse _ = Nothing
     45 
     46 	hasGpgKey Nothing = error $ "Failed to run gpg parser on armored key " ++ keyid
     47 	hasGpgKey (Just GpgPubKey) = hasPubKey key user
     48 	hasGpgKey (Just GpgPrivKey) = hasPrivKey key user
     49 
     50 hasPrivKey :: GpgKeyId -> User -> IO Bool
     51 hasPrivKey (GpgKeyId keyid) (User u) = catchBoolIO $
     52 	snd <$> processTranscript "su" ["--login", "-c", "gpg --list-secret-keys " ++ shellEscape keyid, u] Nothing
     53 
     54 hasPubKey :: GpgKeyId -> User -> IO Bool
     55 hasPubKey (GpgKeyId keyid) (User u) = catchBoolIO $
     56 	snd <$> processTranscript "su" ["--login", "-c", "gpg --list-public-keys " ++ shellEscape keyid, u] Nothing
     57 
     58 dotDir :: User -> IO FilePath
     59 dotDir (User u) = do
     60 	home <- homeDirectory <$> getUserEntryForName u
     61 	return $ home </> ".gnupg"