From 6075fc636dfd9d8c946ed11a58ffa7059dd560d0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 12 Apr 2014 21:34:25 -0400 Subject: propellor spin --- Propellor/Property.hs | 16 +++++++++++----- Propellor/Property/Git.hs | 2 +- Propellor/Property/Gpg.hs | 41 +++++++++++++++++++++++++++++++++++++++++ Propellor/Property/Ssh.hs | 27 ++++++++++++++++++++++++++- Propellor/Types.hs | 8 +++++++- 5 files changed, 86 insertions(+), 8 deletions(-) create mode 100644 Propellor/Property/Gpg.hs (limited to 'Propellor') diff --git a/Propellor/Property.hs b/Propellor/Property.hs index 83e19a73..3e41fbcb 100644 --- a/Propellor/Property.hs +++ b/Propellor/Property.hs @@ -12,6 +12,7 @@ import Propellor.Types import Propellor.Types.Attr import Propellor.Engine import Utility.Monad +import System.FilePath makeChange :: IO () -> Propellor Result makeChange a = liftIO a >> return MadeChange @@ -52,14 +53,19 @@ p1 `before` p2 = Property (propertyDesc p1) $ do -- file to indicate whether it has run before. -- Use with caution. flagFile :: Property -> FilePath -> Property -flagFile property flagfile = Property (propertyDesc property) $ - go =<< liftIO (doesFileExist flagfile) +flagFile property = flagFile' property . return + +flagFile' :: Property -> IO FilePath -> Property +flagFile' property getflagfile = Property (propertyDesc property) $ do + flagfile <- liftIO getflagfile + go flagfile =<< liftIO (doesFileExist flagfile) where - go True = return NoChange - go False = do + go _ True = return NoChange + go flagfile False = do r <- ensureProperty property when (r == MadeChange) $ liftIO $ - unlessM (doesFileExist flagfile) $ + unlessM (doesFileExist flagfile) $ do + createDirectoryIfMissing True (takeDirectory flagfile) writeFile flagfile "" return r diff --git a/Propellor/Property/Git.hs b/Propellor/Property/Git.hs index 6f3c0364..6541dc74 100644 --- a/Propellor/Property/Git.hs +++ b/Propellor/Property/Git.hs @@ -65,7 +65,7 @@ cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property cloned owner url dir mbranch = check originurl (Property desc checkout) `requires` installed where - desc = "git cloned " ++ url ++ " " ++ dir + desc = "git cloned " ++ url ++ " to " ++ dir gitconfig = dir ".git/config" originurl = ifM (doesFileExist gitconfig) ( do diff --git a/Propellor/Property/Gpg.hs b/Propellor/Property/Gpg.hs new file mode 100644 index 00000000..e23111bb --- /dev/null +++ b/Propellor/Property/Gpg.hs @@ -0,0 +1,41 @@ +module Propellor.Property.Gpg where + +import Propellor +import qualified Propellor.Property.Apt as Apt +import Utility.FileSystemEncoding + +import System.PosixCompat + +installed :: Property +installed = Apt.installed ["gnupg"] + +-- | Sets up a user with a gpg key from the privdata. +-- +-- Note that if a secret key is exported using gpg -a --export-secret-key, +-- the public key is also included. Or just a public key could be +-- exported, and this would set it up just as well. +-- +-- Recommend only using this for low-value dedicated role keys. +-- No attempt has been made to scrub the key out of memory once it's used. +-- +-- The GpgKeyId does not have to be a numeric id; it can just as easily +-- be a description of the key. +keyImported :: GpgKeyId -> UserName -> Property +keyImported keyid user = flagFile' (Property desc go) genflag + `requires` installed + where + desc = user ++ " has gpg key " ++ show keyid + genflag = do + d <- dotDir user + return $ d ".propellor-imported-keyid-" ++ keyid + go = withPrivData (GpgKey keyid) $ \key -> makeChange $ + withHandle StdinHandle createProcessSuccess + (proc "su" ["-c", "gpg --import", user]) $ \h -> do + fileEncoding h + hPutStr h key + hClose h + +dotDir :: UserName -> IO FilePath +dotDir user = do + home <- homeDirectory <$> getUserEntryForName user + return $ home ".gnupg" diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs index 59845f8f..42809359 100644 --- a/Propellor/Property/Ssh.hs +++ b/Propellor/Property/Ssh.hs @@ -4,13 +4,17 @@ module Propellor.Property.Ssh ( passwordAuthentication, hasAuthorizedKeys, restartSshd, - uniqueHostKeys + uniqueHostKeys, + keyImported ) where import Propellor import qualified Propellor.Property.File as File import Propellor.Property.User import Utility.SafeCommand +import Utility.FileMode + +import System.PosixCompat sshBool :: Bool -> String sshBool True = "yes" @@ -60,3 +64,24 @@ uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" ensureProperty $ cmdProperty "/var/lib/dpkg/info/openssh-server.postinst" ["configure"] + +-- | Sets up a user with a ssh private key from the site's privdata. +-- +-- The ssh public key (.pub) is not installed. Ssh does not use it. +keyImported :: SshKeyType -> UserName -> Property +keyImported keytype user = Property desc install + where + desc = user ++ " has ssh key" + install = do + f <- liftIO keyfile + ifM (liftIO $ doesFileExist f) + ( noChange + , withPrivData (SshKey keytype user) $ \key -> makeChange $ + writeFileProtected f key + ) + keyfile = do + home <- homeDirectory <$> getUserEntryForName user + return $ home ".ssh" "id_" ++ + case keytype of + SshRsa -> "rsa" + SshDsa -> "dsa" diff --git a/Propellor/Types.hs b/Propellor/Types.hs index e6e02126..a30b183c 100644 --- a/Propellor/Types.hs +++ b/Propellor/Types.hs @@ -27,6 +27,8 @@ module Propellor.Types , ActionResult(..) , CmdLine(..) , PrivDataField(..) + , GpgKeyId + , SshKeyType(..) ) where import Data.Monoid @@ -162,9 +164,13 @@ data CmdLine -- It's fine to add new fields. data PrivDataField = DockerAuthentication - | SshPrivKey UserName + | SshKey SshKeyType UserName | Password UserName | PrivFile FilePath + | GpgKey GpgKeyId deriving (Read, Show, Ord, Eq) +type GpgKeyId = String +data SshKeyType = SshRsa | SshDsa + deriving (Read, Show, Ord, Eq) -- cgit v1.2.3