summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/User.hs
blob: ea88a1b348076f9c8d236213daff979af240e467 (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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
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 nohomedir go
	`describe` ("account for " ++ u)
  where
	nohomedir = isNothing <$> catchMaybeIO (homedir user)
	go = cmdProperty "adduser"
		[ "--disabled-password"
		, "--gecos", ""
		, u
		]

-- | Removes user home directory!! Use with caution.
nuked :: User -> Eep -> Property NoInfo
nuked user@(User u) _ = check hashomedir go
	`describe` ("nuked user " ++ u)
  where
	hashomedir = isJust <$> catchMaybeIO (homedir user)
	go = cmdProperty "userdel"
		[ "-r"
		, 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) = chpasswd (User user) (privDataVal password) []
	go (CryptPassword user, hash) = chpasswd (User user) (privDataVal hash) ["--encrypted"]
	go (f, _) = error $ "Unexpected type of privdata: " ++ show f

-- | Makes a user's password be the passed String. Highly insecure:
-- The password is right there in your config file for anyone to see!
hasInsecurePassword :: User -> String -> Property NoInfo
hasInsecurePassword u@(User n) p = property (n ++ " has insecure password") $
	chpasswd u p []

chpasswd :: User -> String -> [String] -> Propellor Result
chpasswd (User 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) go
	`describe` ("locked " ++ u ++ " password")
  where
	go = cmdProperty "passwd"
		[ "--lock"
		, u
		]

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 go
	`describe` unwords ["user", user, "in group", group']
  where
	test = not . elem group' . words <$> readProcess "groups" [user]
	go = cmdProperty "adduser"
		[ user
		, group'
		]

-- | Gives a user access to the secondary groups, including audio and
-- video, that the OS installer normally gives a desktop user access to.
--
-- Note that some groups may only exit after installation of other
-- software. When a group does not exist yet, the user won't be added to it.
hasDesktopGroups :: User -> Property NoInfo
hasDesktopGroups user@(User u) = property desc $ do
	existinggroups <- map (fst . break (== ':')) . lines
		<$> liftIO (readFile "/etc/group")
	let toadd = filter (`elem` existinggroups) desktopgroups
	ensureProperty $ propertyList desc $ map (hasGroup user . Group) toadd
  where
	desc = "user " ++ u ++ " is in standard desktop groups"
	-- This list comes from user-setup's debconf
	-- template named "passwd/user-default-groups"
	desktopgroups = 
		[ "audio"
		, "cdrom"
		, "dip"
		, "floppy"
		, "video"
		, "plugdev"
		, "netdev"
		, "scanner"
		, "bluetooth"
		, "debian-tor"
		, "lpadmin"
		]

-- | 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