summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Ssh.hs
diff options
context:
space:
mode:
authorJoey Hess2015-04-22 13:04:39 -0400
committerJoey Hess2015-04-22 13:04:39 -0400
commitf35ef9d6975710f2d77c2ea708c66500861d92d1 (patch)
treece00d88d1f67109b62dcdec56262e63471fba412 /src/Propellor/Property/Ssh.hs
parentd3dbdb1f4d47142c20a498dc9279e480900b86c5 (diff)
API change: Added User and Group newtypes, and Properties that used to use the type UserName = String were changed to use them.
Note that UserName is kept and PrivData still uses it in its sum type. This is to avoid breaking PrivData serialization.
Diffstat (limited to 'src/Propellor/Property/Ssh.hs')
-rw-r--r--src/Propellor/Property/Ssh.hs54
1 files changed, 27 insertions, 27 deletions
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 1fbf92ec..236016ff 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -54,17 +54,17 @@ permitRootLogin = setSshdConfig "PermitRootLogin"
passwordAuthentication :: Bool -> Property NoInfo
passwordAuthentication = setSshdConfig "PasswordAuthentication"
-dotDir :: UserName -> IO FilePath
+dotDir :: User -> IO FilePath
dotDir user = do
h <- homedir user
return $ h </> ".ssh"
-dotFile :: FilePath -> UserName -> IO FilePath
+dotFile :: FilePath -> User -> IO FilePath
dotFile f user = do
d <- dotDir user
return $ d </> f
-hasAuthorizedKeys :: UserName -> IO Bool
+hasAuthorizedKeys :: User -> IO Bool
hasAuthorizedKeys = go <=< dotFile "authorized_keys"
where
go f = not . null <$> catchDefaultIO "" (readFile f)
@@ -151,19 +151,19 @@ getPubKey = asks (_sshPubKey . hostInfo)
-- PrivData.
--
-- If the user already has a private/public key, it is left unchanged.
-keyImported :: IsContext c => SshKeyType -> UserName -> c -> Property HasInfo
+keyImported :: IsContext c => SshKeyType -> User -> c -> Property HasInfo
keyImported = keyImported' Nothing
-- | A file can be speficied to write the key to somewhere other than
-- usual. Allows a user to have multiple keys for different roles.
-keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> UserName -> c -> Property HasInfo
-keyImported' dest keytype user context = combineProperties desc
- [ installkey (SshPubKey keytype user) (install writeFile ".pub")
- , installkey (SshPrivKey keytype user) (install writeFileProtected "")
+keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> User -> c -> Property HasInfo
+keyImported' dest keytype user@(User u) context = combineProperties desc
+ [ installkey (SshPubKey keytype u) (install writeFile ".pub")
+ , installkey (SshPrivKey keytype u) (install writeFileProtected "")
]
where
desc = unwords $ catMaybes
- [ Just user
+ [ Just u
, Just "has ssh key"
, dest
, Just $ "(" ++ fromKeyType keytype ++ ")"
@@ -178,13 +178,13 @@ keyImported' dest keytype user context = combineProperties desc
[ property desc $ makeChange $ do
createDirectoryIfMissing True (takeDirectory f)
writer f key
- , File.ownerGroup f user user
- , File.ownerGroup (takeDirectory f) user user
+ , File.ownerGroup f user (userGroup user)
+ , File.ownerGroup (takeDirectory f) user (userGroup user)
]
)
keyfile ext = case dest of
Nothing -> do
- home <- homeDirectory <$> getUserEntryForName user
+ home <- homeDirectory <$> getUserEntryForName u
return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
Just f -> return $ f ++ ext
@@ -196,19 +196,19 @@ fromKeyType SshEd25519 = "ed25519"
-- | Puts some host's ssh public key(s), as set using 'pubKey' or 'hostKey'
-- into the known_hosts file for a user.
-knownHost :: [Host] -> HostName -> UserName -> Property NoInfo
-knownHost hosts hn user = property desc $
+knownHost :: [Host] -> HostName -> User -> Property NoInfo
+knownHost hosts hn user@(User u) = property desc $
go =<< fromHost hosts hn getPubKey
where
- desc = user ++ " knows ssh key for " ++ hn
+ desc = u ++ " knows ssh key for " ++ hn
go (Just m) | not (M.null m) = do
f <- liftIO $ dotFile "known_hosts" user
ensureProperty $ combineProperties desc
[ File.dirExists (takeDirectory f)
, f `File.containsLines`
(map (\k -> hn ++ " " ++ k) (M.elems m))
- , File.ownerGroup f user user
- , File.ownerGroup (takeDirectory f) user user
+ , File.ownerGroup f user (userGroup user)
+ , File.ownerGroup (takeDirectory f) user (userGroup user)
]
go _ = do
warningMessage $ "no configred pubKey for " ++ hn
@@ -217,32 +217,32 @@ knownHost hosts hn user = property desc $
-- | Makes a user have authorized_keys from the PrivData
--
-- This removes any other lines from the file.
-authorizedKeys :: IsContext c => UserName -> c -> Property HasInfo
-authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get ->
- property (user ++ " has authorized_keys") $ get $ \v -> do
+authorizedKeys :: IsContext c => User -> c -> Property HasInfo
+authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) context $ \get ->
+ property (u ++ " 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
+ [ File.ownerGroup f user (userGroup user)
+ , File.ownerGroup (takeDirectory f) user (userGroup user)
]
-- | Ensures that a user's authorized_keys contains a line.
-- Any other lines in the file are preserved as-is.
-authorizedKey :: UserName -> String -> Property NoInfo
-authorizedKey user l = property desc $ do
+authorizedKey :: User -> String -> Property NoInfo
+authorizedKey user@(User u) l = property desc $ do
f <- liftIO $ dotFile "authorized_keys" user
ensureProperty $ combineProperties desc
[ f `File.containsLine` l
`requires` File.dirExists (takeDirectory f)
`onChange` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
- , File.ownerGroup f user user
- , File.ownerGroup (takeDirectory f) user user
+ , File.ownerGroup f user (userGroup user)
+ , File.ownerGroup (takeDirectory f) user (userGroup user)
]
where
- desc = user ++ " has autorized_keys"
+ desc = u ++ " has autorized_keys"
-- | Makes the ssh server listen on a given port, in addition to any other
-- ports it is configured to listen on.