From c97285a21ea0e392e8c63c1898ee2deeb34e99a0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 13 Apr 2014 02:28:40 -0400 Subject: propellor spin --- Propellor/Attr.hs | 17 ++++++++++++++ Propellor/Property/Obnam.hs | 37 ++++++++++++++++++++++-------- Propellor/Property/SiteSpecific/GitHome.hs | 6 ++--- Propellor/Property/Ssh.hs | 35 ++++++++++++++++++++++++---- Propellor/Property/User.hs | 8 +++---- Propellor/Types/Attr.hs | 5 +++- config-joey.hs | 11 +++++---- 7 files changed, 91 insertions(+), 28 deletions(-) diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs index 4bc1c2c7..67ea8b8c 100644 --- a/Propellor/Attr.hs +++ b/Propellor/Attr.hs @@ -8,6 +8,7 @@ import Propellor.Types.Attr import "mtl" Control.Monad.Reader import qualified Data.Set as S import qualified Data.Map as M +import Control.Applicative pureAttrProperty :: Desc -> (Attr -> Attr) -> AttrProperty pureAttrProperty desc = AttrProperty $ Property ("has " ++ desc) @@ -31,6 +32,13 @@ cnameFor domain mkp = addCName :: HostName -> Attr -> Attr addCName domain d = d { _cnames = S.insert domain (_cnames d) } +sshPubKey :: String -> AttrProperty +sshPubKey k = pureAttrProperty ("ssh pubkey known") $ + \d -> d { _sshPubKey = Just k } + +getSshPubKey :: Propellor (Maybe String) +getSshPubKey = asks _sshPubKey + hostnameless :: Attr hostnameless = newAttr (error "hostname Attr not specified") @@ -45,3 +53,12 @@ hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l findHost :: [Host] -> HostName -> Maybe Host findHost l hn = M.lookup hn (hostMap l) + +-- | Lifts an action into a different host. +-- +-- For example, `fromHost hosts "otherhost" getSshPubKey` +fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a) +fromHost l hn getter = case findHost l hn of + Nothing -> return Nothing + Just h -> liftIO $ Just <$> + runReaderT (runWithAttr getter) (hostAttr h) diff --git a/Propellor/Property/Obnam.hs b/Propellor/Property/Obnam.hs index ebdcb9dd..b7d34223 100644 --- a/Propellor/Property/Obnam.hs +++ b/Propellor/Property/Obnam.hs @@ -5,11 +5,21 @@ import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Cron as Cron import Utility.SafeCommand +import Data.List + installed :: Property installed = Apt.installed ["obnam"] type ObnamParam = String +-- | An obnam repository can be used by multiple clients. Obnam uses +-- locking to allow only one client to write at a time. Since stale lock +-- files can prevent backups from happening, it's more robust, if you know +-- a repository has only one client, to force the lock before starting a +-- backup. Using OnlyClient allows propellor to do so when running obnam. +data NumClients = OnlyClient | MultipleClients + deriving (Eq) + -- | Installs a cron job that causes a given directory to be backed -- up, by running obnam with some parameters. -- @@ -23,25 +33,32 @@ type ObnamParam = String -- up securely. For example: -- -- > & Obnam.backup "/srv/git" "33 3 * * *" --- > [ "--repository=2318@usw-s002.rsync.net:mygitrepos.obnam" +-- > [ "--repository=sftp://2318@usw-s002.rsync.net/~/mygitrepos.obnam" -- > , "--encrypt-with=1B169BE1" --- > ] +-- > ] Obnam.OnlyClient -- > `requires` Gpg.keyImported "1B169BE1" "root" -- > `requires` Ssh.keyImported SshRsa "root" -- -- How awesome is that? -backup :: FilePath -> Cron.CronTimes -> [ObnamParam] -> Property -backup dir crontimes params = cronjob `describe` desc +backup :: FilePath -> Cron.CronTimes -> [ObnamParam] -> NumClients -> Property +backup dir crontimes params numclients = cronjob `describe` desc `requires` restored dir params - `requires` installed where desc = dir ++ " backed up by obnam" cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes "root" "/" $ - unwords $ - [ "obnam" - , "backup" - , shellEscape dir - ] ++ map shellEscape params + intercalate ";" $ catMaybes + [ if numclients == OnlyClient + then Just $ unwords $ + [ "obnam" + , "force-lock" + ] ++ map shellEscape params + else Nothing + , Just $ unwords $ + [ "obnam" + , "backup" + , shellEscape dir + ] ++ map shellEscape params + ] -- | Restores a directory from an obnam backup. -- diff --git a/Propellor/Property/SiteSpecific/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs index 1ba56b94..ee46a9e4 100644 --- a/Propellor/Property/SiteSpecific/GitHome.hs +++ b/Propellor/Property/SiteSpecific/GitHome.hs @@ -11,8 +11,7 @@ installedFor user = check (not <$> hasGitDir user) $ Property ("githome " ++ user) (go =<< liftIO (homedir user)) `requires` Apt.installed ["git"] where - go Nothing = noChange - go (Just home) = do + go home = do let tmpdir = home "githome" ensureProperty $ combineProperties "githome setup" [ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir] @@ -32,5 +31,4 @@ url = "git://git.kitenet.net/joey/home" hasGitDir :: UserName -> IO Bool hasGitDir user = go =<< homedir user where - go Nothing = return False - go (Just home) = doesDirectoryExist (home ".git") + go home = doesDirectoryExist (home ".git") diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs index 51649fd9..009511dd 100644 --- a/Propellor/Property/Ssh.hs +++ b/Propellor/Property/Ssh.hs @@ -5,7 +5,8 @@ module Propellor.Property.Ssh ( hasAuthorizedKeys, restartSshd, uniqueHostKeys, - keyImported + keyImported, + knownHost, ) where import Propellor @@ -39,12 +40,20 @@ permitRootLogin = setSshdConfig "PermitRootLogin" passwordAuthentication :: Bool -> Property passwordAuthentication = setSshdConfig "PasswordAuthentication" +dotDir :: UserName -> IO FilePath +dotDir user = do + h <- homedir user + return $ h ".ssh" + +dotFile :: FilePath -> UserName -> IO FilePath +dotFile f user = do + d <- dotDir user + return $ d f + hasAuthorizedKeys :: UserName -> IO Bool -hasAuthorizedKeys = go <=< homedir +hasAuthorizedKeys = go <=< dotFile "authorized_keys" where - go Nothing = return False - go (Just home) = not . null <$> catchDefaultIO "" - (readFile $ home ".ssh" "authorized_keys") + go f = not . null <$> catchDefaultIO "" (readFile f) restartSshd :: Property restartSshd = cmdProperty "service" ["ssh", "restart"] @@ -87,3 +96,19 @@ keyImported keytype user = propertyList desc SshRsa -> "rsa" SshDsa -> "dsa" ++ ext + +-- | Puts some host's ssh public key into the known_hosts file for a user. +knownHost :: [Host] -> HostName -> UserName -> Property +knownHost hosts hn user = Property desc $ + go =<< fromHost hosts hn getSshPubKey + where + desc = user ++ " knows ssh key for " ++ hn + go (Just (Just k)) = do + f <- liftIO $ dotFile "known_hosts" user + ensureProperty $ propertyList desc + [ File.dirExists (takeDirectory f) + , f `File.containsLine` (hn ++ " " ++ k) + ] + go _ = do + warningMessage $ "no configred sshPubKey for " ++ hn + return FailedChange diff --git a/Propellor/Property/User.hs b/Propellor/Property/User.hs index 9d948834..8e7afd81 100644 --- a/Propellor/Property/User.hs +++ b/Propellor/Property/User.hs @@ -7,7 +7,7 @@ import Propellor data Eep = YesReallyDeleteHome accountFor :: UserName -> Property -accountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser" +accountFor user = check (isNothing <$> catchMaybeIO (homedir user)) $ cmdProperty "adduser" [ "--disabled-password" , "--gecos", "" , user @@ -16,7 +16,7 @@ accountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser" -- | Removes user home directory!! Use with caution. nuked :: UserName -> Eep -> Property -nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel" +nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "userdel" [ "-r" , user ] @@ -57,5 +57,5 @@ getPasswordStatus user = parse . words <$> readProcess "passwd" ["-S", user] isLockedPassword :: UserName -> IO Bool isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user -homedir :: UserName -> IO (Maybe FilePath) -homedir user = catchMaybeIO $ homeDirectory <$> getUserEntryForName user +homedir :: UserName -> IO FilePath +homedir user = homeDirectory <$> getUserEntryForName user diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs index c253e32b..cdbe9ca3 100644 --- a/Propellor/Types/Attr.hs +++ b/Propellor/Types/Attr.hs @@ -6,6 +6,7 @@ import qualified Data.Set as S data Attr = Attr { _hostname :: HostName , _cnames :: S.Set Domain + , _sshPubKey :: Maybe String , _dockerImage :: Maybe String , _dockerRunParams :: [HostName -> String] @@ -15,6 +16,7 @@ instance Eq Attr where x == y = and [ _hostname x == _hostname y , _cnames x == _cnames y + , _sshPubKey x == _sshPubKey y , _dockerImage x == _dockerImage y , let simpl v = map (\a -> a "") (_dockerRunParams v) @@ -25,12 +27,13 @@ instance Show Attr where show a = unlines [ "hostname " ++ _hostname a , "cnames " ++ show (_cnames a) + , "sshPubKey " ++ show (_sshPubKey a) , "docker image " ++ show (_dockerImage a) , "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a)) ] newAttr :: HostName -> Attr -newAttr hn = Attr hn S.empty Nothing [] +newAttr hn = Attr hn S.empty Nothing Nothing [] type HostName = String type Domain = String diff --git a/config-joey.hs b/config-joey.hs index a983e87b..e66df10a 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -74,13 +74,12 @@ hosts = & Git.daemonRunning "/srv/git" & File.ownerGroup "/srv/git" "joey" "joey" & Obnam.backup "/srv/git" "33 3 * * *" - [ "--repository=2318@usw-s002.rsync.net:git.kitenet.net" + [ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net.obnam" , "--encrypt-with=1B169BE1" - ] + ] Obnam.OnlyClient `requires` Gpg.keyImported "1B169BE1" "root" `requires` Ssh.keyImported SshRsa "root" - - -- git repos restore (how?) (also make backups!) + `requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root" -- family annex needs family members to have accounts, -- ssh host key etc.. finesse? -- (also should upgrade git-annex-shell for it..) @@ -89,6 +88,10 @@ hosts = -- gitweb -- downloads.kitenet.net setup (including ssh key to turtle) + -- I don't run this system, but tell propellor its public key. + , host "usw-s002.rsync.net" + & sshPubKey "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ==" + --' __|II| ,. ---- __|II|II|__ ( \_,/\ ------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'- -- cgit v1.2.3