From 82da31b3e0e9acdfbca4c48eb12ab1f28515ba10 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 9 Jul 2014 22:11:31 -0400 Subject: propellor (0.8.1) unstable; urgency=medium * Run apt-get update in initial bootstrap. * --list-fields now includes a table of fields that are not currently set, but would be used if they got set. * Remove .gitignore from cabal file list, to avoid build failure on Debian. Closes: #754334 # imported from the archive --- src/Propellor/Property/Ssh.hs | 166 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 166 insertions(+) create mode 100644 src/Propellor/Property/Ssh.hs (limited to 'src/Propellor/Property/Ssh.hs') diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs new file mode 100644 index 00000000..5a260476 --- /dev/null +++ b/src/Propellor/Property/Ssh.hs @@ -0,0 +1,166 @@ +module Propellor.Property.Ssh ( + setSshdConfig, + permitRootLogin, + passwordAuthentication, + hasAuthorizedKeys, + restartSshd, + randomHostKeys, + hostKeys, + hostKey, + keyImported, + knownHost, + authorizedKeys +) 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" +sshBool False = "no" + +sshdConfig :: FilePath +sshdConfig = "/etc/ssh/sshd_config" + +setSshdConfig :: String -> Bool -> Property +setSshdConfig setting allowed = combineProperties "sshd config" + [ sshdConfig `File.lacksLine` (sshline $ not allowed) + , sshdConfig `File.containsLine` (sshline allowed) + ] + `onChange` restartSshd + `describe` unwords [ "ssh config:", setting, sshBool allowed ] + where + sshline v = setting ++ " " ++ sshBool v + +permitRootLogin :: Bool -> Property +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 <=< dotFile "authorized_keys" + where + go f = not . null <$> catchDefaultIO "" (readFile f) + +restartSshd :: Property +restartSshd = cmdProperty "service" ["ssh", "restart"] + +-- | Blows away existing host keys and make new ones. +-- Useful for systems installed from an image that might reuse host keys. +-- A flag file is used to only ever do this once. +randomHostKeys :: Property +randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" + `onChange` restartSshd + where + prop = property "ssh random host keys" $ do + void $ liftIO $ boolSystem "sh" + [ Param "-c" + , Param "rm -f /etc/ssh/ssh_host_*" + ] + ensureProperty $ scriptProperty + [ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ] + +-- | Sets all types of ssh host keys from the privdata. +hostKeys :: Context -> Property +hostKeys ctx = propertyList "known ssh host keys" + [ hostKey SshDsa ctx + , hostKey SshRsa ctx + , hostKey SshEcdsa ctx + ] + +-- | Sets a single ssh host key from the privdata. +hostKey :: SshKeyType -> Context -> Property +hostKey keytype context = combineProperties desc + [ installkey (SshPubKey keytype "") (install writeFile ".pub") + , installkey (SshPrivKey keytype "") (install writeFileProtected "") + ] + `onChange` restartSshd + where + desc = "known ssh host key (" ++ fromKeyType keytype ++ ")" + installkey p a = withPrivData p context $ \getkey -> + property desc $ getkey a + install writer ext key = do + let f = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext + s <- liftIO $ readFileStrict f + if s == key + then noChange + else makeChange $ writer f key + +-- | Sets up a user with a ssh private key and public key pair from the +-- PrivData. +keyImported :: SshKeyType -> UserName -> Context -> Property +keyImported keytype user context = combineProperties desc + [ installkey (SshPubKey keytype user) (install writeFile ".pub") + , installkey (SshPrivKey keytype user) (install writeFileProtected "") + ] + where + desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")" + installkey p a = withPrivData p context $ \getkey -> + property desc $ getkey a + install writer ext key = do + f <- liftIO $ keyfile ext + ifM (liftIO $ doesFileExist f) + ( noChange + , ensureProperties + [ property desc $ makeChange $ do + createDirectoryIfMissing True (takeDirectory f) + writer f key + , File.ownerGroup f user user + , File.ownerGroup (takeDirectory f) user user + ] + ) + keyfile ext = do + home <- homeDirectory <$> getUserEntryForName user + return $ home ".ssh" "id_" ++ fromKeyType keytype ++ ext + +fromKeyType :: SshKeyType -> String +fromKeyType SshRsa = "rsa" +fromKeyType SshDsa = "dsa" +fromKeyType SshEcdsa = "ecdsa" +fromKeyType SshEd25519 = "ed25519" + +-- | 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 $ combineProperties desc + [ File.dirExists (takeDirectory f) + , f `File.containsLine` (hn ++ " " ++ k) + , File.ownerGroup f user user + ] + go _ = do + warningMessage $ "no configred sshPubKey for " ++ hn + return FailedChange + +-- | Makes a user have authorized_keys from the PrivData +authorizedKeys :: UserName -> Context -> Property +authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get -> + property (user ++ " has authorized_keys") $ get $ \v -> do + f <- liftIO $ dotFile "authorized_keys" user + liftIO $ do + createDirectoryIfMissing True (takeDirectory f) + writeFileProtected f v + ensureProperties + [ File.ownerGroup f user user + , File.ownerGroup (takeDirectory f) user user + ] -- cgit v1.3-2-g0d8e