summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/User.hs
blob: c331473829d6164eebcf6c531a9a18c8ea85b68e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
module Propellor.Property.User where

import System.Posix

import Propellor.Base
import qualified Propellor.Property.File as File

data Eep = YesReallyDeleteHome

accountFor :: User -> Property NoInfo
accountFor user@(User u) = check (isNothing <$> catchMaybeIO (homedir user)) $ cmdProperty "adduser"
	[ "--disabled-password"
	, "--gecos", ""
	, u
	]
	`describe` ("account for " ++ u)

-- | Removes user home directory!! Use with caution.
nuked :: User -> Eep -> Property NoInfo
nuked user@(User u) _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "userdel"
	[ "-r"
	, u
	]
	`describe` ("nuked user " ++ u)

-- | Only ensures that the user has some password set. It may or may
-- not be a password from the PrivData.
hasSomePassword :: User -> Property HasInfo
hasSomePassword user = hasSomePassword' user hostContext

-- | While hasSomePassword uses the name of the host as context,
-- this allows specifying a different context. This is useful when
-- you want to use the same password on multiple hosts, for example.
hasSomePassword' :: IsContext c => User -> c -> Property HasInfo
hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $
	hasPassword' user context

-- | Ensures that a user's password is set to a password from the PrivData.
-- (Will change any existing password.)
--
-- A user's password can be stored in the PrivData in either of two forms;
-- the full cleartext <Password> or a <CryptPassword> hash. The latter
-- is obviously more secure.
hasPassword :: User -> Property HasInfo
hasPassword user = hasPassword' user hostContext

hasPassword' :: IsContext c => User -> c -> Property HasInfo
hasPassword' (User u) context = go `requires` shadowConfig True
  where
	go = withSomePrivData srcs context $
		property (u ++ " has password") . setPassword
	srcs =
		[ PrivDataSource (CryptPassword u)
			"a crypt(3)ed password, which can be generated by, for example: perl -e 'print crypt(shift, q{$6$}.shift)' 'somepassword' 'somesalt'"
		, PrivDataSource (Password u) ("a password for " ++ u)
		]

setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
setPassword getpassword = getpassword $ go
  where
	go (Password user, password) = set user (privDataVal password) []
	go (CryptPassword user, hash) = set user (privDataVal hash) ["--encrypted"]
	go (f, _) = error $ "Unexpected type of privdata: " ++ show f

	set user v ps = makeChange $ withHandle StdinHandle createProcessSuccess
		(proc "chpasswd" ps) $ \h -> do
			hPutStrLn h $ user ++ ":" ++ v
			hClose h

lockedPassword :: User -> Property NoInfo
lockedPassword user@(User u) = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
	[ "--lock"
	, u
	]
	`describe` ("locked " ++ u ++ " password")

data PasswordStatus = NoPassword | LockedPassword | HasPassword
	deriving (Eq)

getPasswordStatus :: User -> IO PasswordStatus
getPasswordStatus (User u) = parse . words <$> readProcess "passwd" ["-S", u]
  where
	parse (_:"L":_) = LockedPassword
	parse (_:"NP":_) = NoPassword
	parse (_:"P":_) = HasPassword
	parse _ = NoPassword

isLockedPassword :: User -> IO Bool
isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user

homedir :: User -> IO FilePath
homedir (User user) = homeDirectory <$> getUserEntryForName user

hasGroup :: User -> Group -> Property NoInfo
hasGroup (User user) (Group group') = check test $ cmdProperty "adduser"
	[ user
	, group'
	]
	`describe` unwords ["user", user, "in group", group']
  where
	test = not . elem group' . words <$> readProcess "groups" [user]

-- | Controls whether shadow passwords are enabled or not.
shadowConfig :: Bool -> Property NoInfo
shadowConfig True = check (not <$> shadowExists) $
	cmdProperty "shadowconfig" ["on"]
		`describe` "shadow passwords enabled"
shadowConfig False = check shadowExists $
	cmdProperty "shadowconfig" ["off"]
		`describe` "shadow passwords disabled"

shadowExists :: IO Bool
shadowExists = doesFileExist "/etc/shadow"

-- | Ensures that a user has a specified login shell, and that the shell
-- is enabled in /etc/shells.
hasLoginShell :: User -> FilePath -> Property NoInfo
hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell

shellSetTo :: User -> FilePath -> Property NoInfo
shellSetTo (User u) loginshell = check needchangeshell $
	cmdProperty "chsh" ["--shell", loginshell, u]
		`describe` (u ++ " has login shell " ++ loginshell)
  where
	needchangeshell = do
		currshell <- userShell <$> getUserEntryForName u
		return (currshell /= loginshell)

-- | Ensures that /etc/shells contains a shell.
shellEnabled :: FilePath -> Property NoInfo
shellEnabled loginshell = "/etc/shells" `File.containsLine` loginshell