module Propellor.Property.User where

import System.Posix

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

data Eep = YesReallyDeleteHome

accountFor :: User -> Property DebianLike
accountFor :: User -> Property DebianLike
accountFor user :: User
user@(User UserName
u) = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
nohomedir UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
	forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"account for " forall a. [a] -> [a] -> [a]
++ UserName
u)
  where
	nohomedir :: IO Bool
nohomedir = forall a. Maybe a -> Bool
isNothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (User -> IO UserName
homedir User
user)
	go :: UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = UserName
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty UserName
"adduser"
		[ UserName
"--disabled-password"
		, UserName
"--gecos", UserName
""
		, UserName
u
		]

systemAccountFor :: User -> Property DebianLike
systemAccountFor :: User -> Property DebianLike
systemAccountFor user :: User
user@(User UserName
u) = User -> Maybe UserName -> Maybe Group -> Property DebianLike
systemAccountFor' User
user forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (UserName -> Group
Group UserName
u))

systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property DebianLike
systemAccountFor' :: User -> Maybe UserName -> Maybe Group -> Property DebianLike
systemAccountFor' (User UserName
u) Maybe UserName
mhome Maybe Group
mgroup = case Maybe Group
mgroup of
	Maybe Group
Nothing -> Property DebianLike
prop
	Just Group
g -> Property DebianLike
prop
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Group
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
systemGroup Group
g
	forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"system account for " forall a. [a] -> [a] -> [a]
++ UserName
u)
  where
	prop :: Property DebianLike
prop = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
nouser UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
	nouser :: IO Bool
nouser = forall a. Maybe a -> Bool
isNothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (UserName -> IO UserEntry
getUserEntryForName UserName
u)
	go :: UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = UserName
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty UserName
"adduser" forall a b. (a -> b) -> a -> b
$
		[ UserName
"--system", UserName
"--home" ]
		forall a. [a] -> [a] -> [a]
++
		forall b a. b -> (a -> b) -> Maybe a -> b
maybe [UserName
"/nonexistent", UserName
"--no-create-home"] ( \UserName
h -> [UserName
h] ) Maybe UserName
mhome
		forall a. [a] -> [a] -> [a]
++
		forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ( \(Group UserName
g) -> [UserName
"--ingroup", UserName
g] ) Maybe Group
mgroup
		forall a. [a] -> [a] -> [a]
++
		[ UserName
"--shell", UserName
"/usr/bin/nologin"
		, UserName
"--disabled-login"
		, UserName
"--disabled-password"
		, UserName
u
		]

systemGroup :: Group -> Property UnixLike
systemGroup :: Group
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
systemGroup (Group UserName
g) = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
nogroup UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
	forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"system account for " forall a. [a] -> [a] -> [a]
++ UserName
g)
  where
	nogroup :: IO Bool
nogroup = forall a. Maybe a -> Bool
isNothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (UserName -> IO GroupEntry
getGroupEntryForName UserName
g)
	go :: UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = UserName
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty UserName
"addgroup"
		[ UserName
"--system"
		, UserName
g
		]

-- | Removes user home directory!! Use with caution.
nuked :: User -> Eep -> Property Linux
nuked :: User -> Eep -> Property Linux
nuked user :: User
user@(User UserName
u) Eep
_ = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
hashomedir UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
	forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"nuked user " forall a. [a] -> [a] -> [a]
++ UserName
u)
  where
	hashomedir :: IO Bool
hashomedir = forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (User -> IO UserName
homedir User
user)
	go :: UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = UserName
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty UserName
"userdel"
		[ UserName
"-r"
		, UserName
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 + DebianLike)
hasSomePassword :: User -> Property (HasInfo + DebianLike)
hasSomePassword User
user = forall c.
IsContext c =>
User -> c -> Property (HasInfo + DebianLike)
hasSomePassword' User
user HostContext
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 + DebianLike)
hasSomePassword' :: forall c.
IsContext c =>
User -> c -> Property (HasInfo + DebianLike)
hasSomePassword' User
user c
context = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check ((forall a. Eq a => a -> a -> Bool
/= PasswordStatus
HasPassword) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> IO PasswordStatus
getPasswordStatus User
user) forall a b. (a -> b) -> a -> b
$
	forall c.
IsContext c =>
User -> c -> Property (HasInfo + DebianLike)
hasPassword' User
user c
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 + DebianLike)
hasPassword :: User -> Property (HasInfo + DebianLike)
hasPassword User
user = forall c.
IsContext c =>
User -> c -> Property (HasInfo + DebianLike)
hasPassword' User
user HostContext
hostContext

hasPassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike)
hasPassword' :: forall c.
IsContext c =>
User -> c -> Property (HasInfo + DebianLike)
hasPassword' (User UserName
u) c
context = Property
  (HasInfo
   + MetaTypes
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Bool -> Property DebianLike
shadowConfig Bool
True
  where
	go :: Property (HasInfo + UnixLike)
	go :: Property
  (HasInfo
   + MetaTypes
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = forall c s metatypes.
(IsContext c, IsPrivDataSource s,
 IncludesInfo metatypes ~ 'True) =>
[s]
-> c
-> ((((PrivDataField, PrivData) -> Propellor Result)
     -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
withSomePrivData [PrivDataSource]
srcs c
context forall a b. (a -> b) -> a -> b
$
		forall {k} (metatypes :: k).
SingI metatypes =>
UserName -> Propellor Result -> Property (MetaTypes metatypes)
property (UserName
u forall a. [a] -> [a] -> [a]
++ UserName
" has password") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((PrivDataField, PrivData) -> Propellor Result)
 -> Propellor Result)
-> Propellor Result
setPassword
	srcs :: [PrivDataSource]
srcs =
		[ PrivDataField -> UserName -> PrivDataSource
PrivDataSource (UserName -> PrivDataField
CryptPassword UserName
u)
			UserName
"a crypt(3)ed password, which can be generated by, for example: perl -e 'print crypt(shift, q{$6$}.shift)' 'somepassword' 'somesalt'"
		, PrivDataField -> UserName -> PrivDataSource
PrivDataSource (UserName -> PrivDataField
Password UserName
u) (UserName
"a password for " forall a. [a] -> [a] -> [a]
++ UserName
u)
		]

setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
setPassword :: (((PrivDataField, PrivData) -> Propellor Result)
 -> Propellor Result)
-> Propellor Result
setPassword ((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result
getpassword = ((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result
getpassword forall a b. (a -> b) -> a -> b
$ (PrivDataField, PrivData) -> Propellor Result
go
  where
	go :: (PrivDataField, PrivData) -> Propellor Result
go (Password UserName
user, PrivData
password) = User -> UserName -> [UserName] -> Propellor Result
chpasswd (UserName -> User
User UserName
user) (PrivData -> UserName
privDataVal PrivData
password) []
	go (CryptPassword UserName
user, PrivData
hash) = User -> UserName -> [UserName] -> Propellor Result
chpasswd (UserName -> User
User UserName
user) (PrivData -> UserName
privDataVal PrivData
hash) [UserName
"--encrypted"]
	go (PrivDataField
f, PrivData
_) = forall a. HasCallStack => UserName -> a
error forall a b. (a -> b) -> a -> b
$ UserName
"Unexpected type of privdata: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> UserName
show PrivDataField
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 DebianLike
hasInsecurePassword :: User -> UserName -> Property DebianLike
hasInsecurePassword u :: User
u@(User UserName
n) UserName
p = Property DebianLike
go
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Bool -> Property DebianLike
shadowConfig Bool
True
  where
	go :: Property DebianLike
	go :: Property DebianLike
go = forall {k} (metatypes :: k).
SingI metatypes =>
UserName -> Propellor Result -> Property (MetaTypes metatypes)
property (UserName
n forall a. [a] -> [a] -> [a]
++ UserName
" has insecure password") forall a b. (a -> b) -> a -> b
$
		User -> UserName -> [UserName] -> Propellor Result
chpasswd User
u UserName
p []

chpasswd :: User -> String -> [String] -> Propellor Result
chpasswd :: User -> UserName -> [UserName] -> Propellor Result
chpasswd (User UserName
user) UserName
v [UserName]
ps = IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ forall a.
StdHandle
-> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a
withHandle StdHandle
StdinHandle CreateProcessRunner
createProcessSuccess
	(UserName -> [UserName] -> CreateProcess
proc UserName
"chpasswd" [UserName]
ps) forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
		Handle -> UserName -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$ UserName
user forall a. [a] -> [a] -> [a]
++ UserName
":" forall a. [a] -> [a] -> [a]
++ UserName
v
		Handle -> IO ()
hClose Handle
h

lockedPassword :: User -> Property DebianLike
lockedPassword :: User -> Property DebianLike
lockedPassword user :: User
user@(User UserName
u) = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
	forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> IO Bool
isLockedPassword User
user) UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
		forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"locked " forall a. [a] -> [a] -> [a]
++ UserName
u forall a. [a] -> [a] -> [a]
++ UserName
" password")
  where
	go :: UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = UserName
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty UserName
"passwd"
		[ UserName
"--lock"
		, UserName
u
		]

data PasswordStatus = NoPassword | LockedPassword | HasPassword
	deriving (PasswordStatus -> PasswordStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasswordStatus -> PasswordStatus -> Bool
$c/= :: PasswordStatus -> PasswordStatus -> Bool
== :: PasswordStatus -> PasswordStatus -> Bool
$c== :: PasswordStatus -> PasswordStatus -> Bool
Eq)

getPasswordStatus :: User -> IO PasswordStatus
getPasswordStatus :: User -> IO PasswordStatus
getPasswordStatus (User UserName
u) = [UserName] -> PasswordStatus
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserName -> [UserName]
words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserName -> [UserName] -> IO UserName
readProcess UserName
"passwd" [UserName
"-S", UserName
u]
  where
	parse :: [UserName] -> PasswordStatus
parse (UserName
_:UserName
"L":[UserName]
_) = PasswordStatus
LockedPassword
	parse (UserName
_:UserName
"NP":[UserName]
_) = PasswordStatus
NoPassword
	parse (UserName
_:UserName
"P":[UserName]
_) = PasswordStatus
HasPassword
	parse [UserName]
_ = PasswordStatus
NoPassword

isLockedPassword :: User -> IO Bool
isLockedPassword :: User -> IO Bool
isLockedPassword User
user = (forall a. Eq a => a -> a -> Bool
== PasswordStatus
LockedPassword) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> IO PasswordStatus
getPasswordStatus User
user

homedir :: User -> IO FilePath
homedir :: User -> IO UserName
homedir (User UserName
user) = UserEntry -> UserName
homeDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserName -> IO UserEntry
getUserEntryForName UserName
user

primaryGroup :: User -> IO Group
primaryGroup :: User -> IO Group
primaryGroup (User UserName
u) = UserName -> Group
Group forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupEntry -> UserName
groupName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
	(GroupID -> IO GroupEntry
getGroupEntryForID forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (UserEntry -> GroupID
userGroupID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserName -> IO UserEntry
getUserEntryForName UserName
u))

hasGroup :: User -> Group -> Property DebianLike
hasGroup :: User -> Group -> Property DebianLike
hasGroup (User UserName
user) (Group UserName
group') = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
test UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
	forall p. IsProp p => p -> UserName -> p
`describe` [UserName] -> UserName
unwords [UserName
"user", UserName
user, UserName
"in group", UserName
group']
  where
	test :: IO Bool
test = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem UserName
group' forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserName -> [UserName]
words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserName -> [UserName] -> IO UserName
readProcess UserName
"groups" [UserName
user]
	go :: UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = UserName
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty UserName
"adduser"
		[ UserName
user
		, UserName
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 DebianLike
hasDesktopGroups :: User -> Property DebianLike
hasDesktopGroups user :: User
user@(User UserName
u) = forall {k} (metatypes :: k).
SingI metatypes =>
UserName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' UserName
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
o -> do
	[UserName]
existinggroups <- forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
':')) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserName -> [UserName]
lines
		forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (UserName -> IO UserName
readFile UserName
"/etc/group")
	let toadd :: [UserName]
toadd = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UserName]
existinggroups) [UserName]
desktopgroups
	forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
o forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
UserName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties UserName
desc forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps forall a b. (a -> b) -> a -> b
$
		forall a b. (a -> b) -> [a] -> [b]
map (User -> Group -> Property DebianLike
hasGroup User
user forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserName -> Group
Group) [UserName]
toadd
  where
	desc :: UserName
desc = UserName
"user " forall a. [a] -> [a] -> [a]
++ UserName
u forall a. [a] -> [a] -> [a]
++ UserName
" is in standard desktop groups"
	-- This list comes from user-setup's debconf
	-- template named "passwd/user-default-groups"
	desktopgroups :: [UserName]
desktopgroups =
		[ UserName
"audio"
		, UserName
"cdrom"
		, UserName
"dip"
		, UserName
"floppy"
		, UserName
"video"
		, UserName
"plugdev"
		, UserName
"netdev"
		, UserName
"scanner"
		, UserName
"bluetooth"
		, UserName
"debian-tor"
		, UserName
"lpadmin"
		]

-- | Ensures that a file is owned by a user, and also by that user's primary
-- group.
ownsWithPrimaryGroup :: User -> FilePath -> Property UnixLike
ownsWithPrimaryGroup :: User
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
ownsWithPrimaryGroup user :: User
user@(User UserName
u) UserName
f =
	forall {k} (metatypes :: k).
SingI metatypes =>
UserName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (UserName
f forall a. [a] -> [a] -> [a]
++ UserName
" has owner " forall a. [a] -> [a] -> [a]
++ UserName
u) forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w -> do
		Group
group <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ User -> IO Group
primaryGroup User
user
		forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w forall a b. (a -> b) -> a -> b
$ UserName
-> User
-> Group
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.ownerGroup UserName
f User
user Group
group

-- | Controls whether shadow passwords are enabled or not.
shadowConfig :: Bool -> Property DebianLike
shadowConfig :: Bool -> Property DebianLike
shadowConfig Bool
True = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
shadowExists)
	(UserName
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty UserName
"shadowconfig" [UserName
"on"])
		forall p. IsProp p => p -> UserName -> p
`describe` UserName
"shadow passwords enabled"
shadowConfig Bool
False = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
shadowExists
	(UserName
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty UserName
"shadowconfig" [UserName
"off"])
		forall p. IsProp p => p -> UserName -> p
`describe` UserName
"shadow passwords disabled"

shadowExists :: IO Bool
shadowExists :: IO Bool
shadowExists = UserName -> IO Bool
doesFileExist UserName
"/etc/shadow"

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

shellSetTo :: User -> FilePath -> Property DebianLike
shellSetTo :: User -> UserName -> Property DebianLike
shellSetTo (User UserName
u) UserName
loginshell = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
needchangeshell
	(UserName
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty UserName
"chsh" [UserName
"--shell", UserName
loginshell, UserName
u])
		forall p. IsProp p => p -> UserName -> p
`describe` (UserName
u forall a. [a] -> [a] -> [a]
++ UserName
" has login shell " forall a. [a] -> [a] -> [a]
++ UserName
loginshell)
  where
	needchangeshell :: IO Bool
needchangeshell = do
		UserName
currshell <- UserEntry -> UserName
userShell forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserName -> IO UserEntry
getUserEntryForName UserName
u
		forall (m :: * -> *) a. Monad m => a -> m a
return (UserName
currshell forall a. Eq a => a -> a -> Bool
/= UserName
loginshell)

-- | Ensures that /etc/shells contains a shell.
shellEnabled :: FilePath -> Property DebianLike
shellEnabled :: UserName -> Property DebianLike
shellEnabled UserName
loginshell = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
	UserName
"/etc/shells" UserName
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.containsLine` UserName
loginshell