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) = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property DebianLike)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ IO Bool
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"account for " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
u)
  where
	nohomedir :: IO Bool
nohomedir = Maybe UserName -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe UserName -> Bool) -> IO (Maybe UserName) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UserName -> IO (Maybe UserName)
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 Maybe UserName
forall a. Maybe a
Nothing (Group -> Maybe Group
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
		Property DebianLike
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property DebianLike)
     (Property
        (MetaTypes
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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
	Property DebianLike -> UserName -> Property DebianLike
forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"system account for " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
u)
  where
	prop :: Property DebianLike
prop = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property DebianLike)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ IO Bool
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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 = Maybe UserEntry -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe UserEntry -> Bool) -> IO (Maybe UserEntry) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UserEntry -> IO (Maybe UserEntry)
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" ([UserName]
 -> UncheckedProperty
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
		[ UserName
"--system", UserName
"--home" ]
		[UserName] -> [UserName] -> [UserName]
forall a. [a] -> [a] -> [a]
++
		[UserName]
-> (UserName -> [UserName]) -> Maybe UserName -> [UserName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [UserName
"/nonexistent", UserName
"--no-create-home"] ( \UserName
h -> [UserName
h] ) Maybe UserName
mhome
		[UserName] -> [UserName] -> [UserName]
forall a. [a] -> [a] -> [a]
++
		[UserName] -> (Group -> [UserName]) -> Maybe Group -> [UserName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ( \(Group UserName
g) -> [UserName
"--ingroup", UserName
g] ) Maybe Group
mgroup
		[UserName] -> [UserName] -> [UserName]
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) = IO Bool
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"system account for " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
g)
  where
	nogroup :: IO Bool
nogroup = Maybe GroupEntry -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe GroupEntry -> Bool) -> IO (Maybe GroupEntry) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO GroupEntry -> IO (Maybe GroupEntry)
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
_ = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ IO Bool
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"nuked user " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
u)
  where
	hashomedir :: IO Bool
hashomedir = Maybe UserName -> Bool
forall a. Maybe a -> Bool
isJust (Maybe UserName -> Bool) -> IO (Maybe UserName) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UserName -> IO (Maybe UserName)
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 = User -> HostContext -> Property (HasInfo + DebianLike)
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' :: User -> c -> Property (HasInfo + DebianLike)
hasSomePassword' User
user c
context = IO Bool
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check ((PasswordStatus -> PasswordStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= PasswordStatus
HasPassword) (PasswordStatus -> Bool) -> IO PasswordStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> IO PasswordStatus
getPasswordStatus User
user) (Property
   (MetaTypes
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
 -> Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$
	User -> c -> Property (HasInfo + DebianLike)
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 = User -> HostContext -> Property (HasInfo + DebianLike)
forall c.
IsContext c =>
User -> c -> Property (HasInfo + DebianLike)
hasPassword' User
user HostContext
hostContext

hasPassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike)
hasPassword' :: User -> c -> Property (HasInfo + DebianLike)
hasPassword' (User UserName
u) c
context = Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
Property
  (HasInfo
   + MetaTypes
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
	Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> CombinedType
     (Property
        (Sing
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property DebianLike)
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 = [PrivDataSource]
-> c
-> ((((PrivDataField, PrivData) -> Propellor Result)
     -> Propellor Result)
    -> Property
         (Sing
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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 (((((PrivDataField, PrivData) -> Propellor Result)
   -> Propellor Result)
  -> Property
       (Sing
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
 -> Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> ((((PrivDataField, PrivData) -> Propellor Result)
     -> Propellor Result)
    -> Property
         (Sing
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
		UserName
-> Propellor Result
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
UserName -> Propellor Result -> Property (MetaTypes metatypes)
property (UserName
u UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
" has password") (Propellor Result
 -> Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> ((((PrivDataField, PrivData) -> Propellor Result)
     -> Propellor Result)
    -> Propellor Result)
-> (((PrivDataField, PrivData) -> Propellor Result)
    -> Propellor Result)
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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 " UserName -> UserName -> UserName
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 (((PrivDataField, PrivData) -> Propellor Result)
 -> Propellor Result)
-> ((PrivDataField, PrivData) -> Propellor Result)
-> Propellor Result
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
_) = UserName -> Propellor Result
forall a. HasCallStack => UserName -> a
error (UserName -> Propellor Result) -> UserName -> Propellor Result
forall a b. (a -> b) -> a -> b
$ UserName
"Unexpected type of privdata: " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ PrivDataField -> UserName
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
	Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
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 = UserName -> Propellor Result -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
UserName -> Propellor Result -> Property (MetaTypes metatypes)
property (UserName
n UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
" has insecure password") (Propellor Result -> Property DebianLike)
-> Propellor Result -> Property DebianLike
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 (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ StdHandle
-> CreateProcessRunner
-> CreateProcess
-> (Handle -> IO ())
-> IO ()
forall a.
StdHandle
-> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a
withHandle StdHandle
StdinHandle CreateProcessRunner
createProcessSuccess
	(UserName -> [UserName] -> CreateProcess
proc UserName
"chpasswd" [UserName]
ps) ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
		Handle -> UserName -> IO ()
hPutStrLn Handle
h (UserName -> IO ()) -> UserName -> IO ()
forall a b. (a -> b) -> a -> b
$ UserName
user UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
":" UserName -> UserName -> 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) = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property DebianLike)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$
	IO Bool
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
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
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> UserName -> p
`describe` (UserName
"locked " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
u UserName -> UserName -> UserName
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
(PasswordStatus -> PasswordStatus -> Bool)
-> (PasswordStatus -> PasswordStatus -> Bool) -> Eq PasswordStatus
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 ([UserName] -> PasswordStatus)
-> (UserName -> [UserName]) -> UserName -> PasswordStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserName -> [UserName]
words (UserName -> PasswordStatus) -> IO UserName -> IO PasswordStatus
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 = (PasswordStatus -> PasswordStatus -> Bool
forall a. Eq a => a -> a -> Bool
== PasswordStatus
LockedPassword) (PasswordStatus -> Bool) -> IO PasswordStatus -> IO Bool
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 (UserEntry -> UserName) -> IO UserEntry -> IO UserName
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 (UserName -> Group)
-> (GroupEntry -> UserName) -> GroupEntry -> Group
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupEntry -> UserName
groupName (GroupEntry -> Group) -> IO GroupEntry -> IO Group
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
	(GroupID -> IO GroupEntry
getGroupEntryForID (GroupID -> IO GroupEntry) -> IO GroupID -> IO GroupEntry
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (UserEntry -> GroupID
userGroupID (UserEntry -> GroupID) -> IO UserEntry -> IO GroupID
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') = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property DebianLike)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ IO Bool
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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 (Bool -> Bool) -> (UserName -> Bool) -> UserName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserName -> [UserName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem UserName
group' ([UserName] -> Bool)
-> (UserName -> [UserName]) -> UserName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserName -> [UserName]
words (UserName -> Bool) -> IO UserName -> IO Bool
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) = UserName
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
UserName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' UserName
desc ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
  -> Propellor Result)
 -> Property DebianLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
o -> do
	[UserName]
existinggroups <- (UserName -> UserName) -> [UserName] -> [UserName]
forall a b. (a -> b) -> [a] -> [b]
map ((UserName, UserName) -> UserName
forall a b. (a, b) -> a
fst ((UserName, UserName) -> UserName)
-> (UserName -> (UserName, UserName)) -> UserName -> UserName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> UserName -> (UserName, UserName)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')) ([UserName] -> [UserName])
-> (UserName -> [UserName]) -> UserName -> [UserName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserName -> [UserName]
lines
		(UserName -> [UserName])
-> Propellor UserName -> Propellor [UserName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UserName -> Propellor UserName
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (UserName -> IO UserName
readFile UserName
"/etc/group")
	let toadd :: [UserName]
toadd = (UserName -> Bool) -> [UserName] -> [UserName]
forall a. (a -> Bool) -> [a] -> [a]
filter (UserName -> [UserName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UserName]
existinggroups) [UserName]
desktopgroups
	OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property DebianLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
o (Property DebianLike -> Propellor Result)
-> Property DebianLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ UserName -> Props DebianLike -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
UserName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties UserName
desc (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ [Property DebianLike] -> Props DebianLike
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property DebianLike] -> Props DebianLike)
-> [Property DebianLike] -> Props DebianLike
forall a b. (a -> b) -> a -> b
$
		(UserName -> Property DebianLike)
-> [UserName] -> [Property DebianLike]
forall a b. (a -> b) -> [a] -> [b]
map (User -> Group -> Property DebianLike
hasGroup User
user (Group -> Property DebianLike)
-> (UserName -> Group) -> UserName -> Property DebianLike
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserName -> Group
Group) [UserName]
toadd
  where
	desc :: UserName
desc = UserName
"user " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
u UserName -> UserName -> UserName
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 =
	UserName
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Propellor Result)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
UserName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (UserName
f UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
" has owner " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
u) ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
       'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
  -> Propellor Result)
 -> Property
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Propellor Result)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w -> do
		Group
group <- IO Group -> Propellor Group
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Group -> Propellor Group) -> IO Group -> Propellor Group
forall a b. (a -> b) -> a -> b
$ User -> IO Group
primaryGroup User
user
		OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Propellor Result
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 (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Propellor Result)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Propellor Result
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 = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property DebianLike)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ IO Bool
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
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"])
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> UserName -> p
`describe` UserName
"shadow passwords enabled"
shadowConfig Bool
False = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property DebianLike)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ IO Bool
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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"])
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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 Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
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 = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property DebianLike)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ IO Bool
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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])
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UserName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> UserName -> p
`describe` (UserName
u UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
" has login shell " UserName -> UserName -> UserName
forall a. [a] -> [a] -> [a]
++ UserName
loginshell)
  where
	needchangeshell :: IO Bool
needchangeshell = do
		UserName
currshell <- UserEntry -> UserName
userShell (UserEntry -> UserName) -> IO UserEntry -> IO UserName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserName -> IO UserEntry
getUserEntryForName UserName
u
		Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (UserName
currshell UserName -> UserName -> Bool
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 = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property DebianLike)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
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