diff --git a/Propellor/Property.hs b/Propellor/Property.hs index 83e19a7..3e41fbc 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 6f3c036..6541dc7 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 0000000..e23111b --- /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 59845f8..4280935 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 e6e0212..a30b183 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) diff --git a/config-joey.hs b/config-joey.hs index 2efb81c..7403f87 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -17,6 +17,7 @@ import qualified Propellor.Property.Dns as Dns import qualified Propellor.Property.OpenId as OpenId import qualified Propellor.Property.Docker as Docker import qualified Propellor.Property.Git as Git +import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.SiteSpecific.GitHome as GitHome import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites @@ -71,6 +72,8 @@ hosts = & Apt.buildDep ["git-annex"] `period` Daily & Git.daemonRunning "/srv/git" & File.ownerGroup "/srv/git" "joey" "joey" + & Gpg.keyImported "git.kitenet.net obnam backup key" "root" + & Ssh.keyImported SshRsa "root" -- git repos restore (how?) (also make backups!) -- family annex needs family members to have accounts, -- ssh host key etc.. finesse? @@ -80,13 +83,13 @@ hosts = -- gitweb -- downloads.kitenet.net setup (including ssh key to turtle) - --' __|II| ,. ----- __|II|II|__ ( \_,/\ ------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'- ---------------------- | [Docker] / ---------------------- ---------------------- : / ----------------------- ----------------------- \____, o ,' ------------------------ ------------------------ '--,___________,' ------------------------- + --' __|II| ,. + ---- __|II|II|__ ( \_,/\ + ------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'- + ----------------------- | [Docker] / ---------------------- + ----------------------- : / ----------------------- + ------------------------ \____, o ,' ------------------------ + ------------------------- '--,___________,' ------------------------- -- Simple web server, publishing the outside host's /var/www , standardContainer "webserver" Stable "amd64" diff --git a/propellor.cabal b/propellor.cabal index 5497cc6..b28a26d 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -76,6 +76,7 @@ Library Propellor.Property.Docker Propellor.Property.File Propellor.Property.Git + Propellor.Property.Gpg Propellor.Property.Network Propellor.Property.OpenId Propellor.Property.Reboot