module Propellor.Property.Sudo where

import Data.List

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

-- | Allows a user to run any command with sudo.
-- If the user has a password, sudo is configured to require it.
-- If not, NOPASSWORD is enabled for the user.
--
-- Writes to the file /etc/sudoers.d/000users rather than the main sudoers
-- file. This file should come before other include files that may eg,
-- allow running more specific commands without a password, since sudo
-- uses the last matching configuration line.
--
-- If the main sudoers file contains a conflicting line for
-- the user for ALL commands, the line will be removed.
--
-- Also ensures that the main sudoers file includes /etc/sudoers.d/
enabledFor :: User -> RevertableProperty DebianLike DebianLike
enabledFor :: User -> RevertableProperty DebianLike DebianLike
enabledFor user :: User
user@(User [Char]
u) = Property UnixLike
setup forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [[Char]] -> Property DebianLike
Apt.installed [[Char]
"sudo"] forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
cleanup
  where
	setup :: Property UnixLike
	setup :: Property UnixLike
setup = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' [Char]
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w -> do
		Bool
locked <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ User -> IO Bool
isLockedPassword 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
$ forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties [Char]
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
			forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Property UnixLike
includessudoersd
			forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
fileProperty [Char]
desc
				(Bool -> [[Char]] -> [[Char]]
modify Bool
locked forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> [Char] -> Bool
wanted Bool
locked))
				[Char]
dfile
			forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& [Char] -> Property UnixLike
removeconflicting [Char]
sudoers
	  where
		desc :: [Char]
desc = [Char]
u forall a. [a] -> [a] -> [a]
++ [Char]
" is sudoer"
	
	cleanup :: Property DebianLike
	cleanup :: Property DebianLike
cleanup = 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 {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties [Char]
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
		forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& [Char] -> Property UnixLike
removeconflicting [Char]
sudoers
		forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& [Char] -> Property UnixLike
removeconflicting [Char]
dfile
	  where
		desc :: [Char]
desc = [Char]
u forall a. [a] -> [a] -> [a]
++ [Char]
" is not sudoer"
	
	removeconflicting :: [Char] -> Property UnixLike
removeconflicting = forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
fileProperty [Char]
"remove conflicting" (forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
notuserline)
	
	-- Not reverted because this line is included by default.
	includessudoersd :: Property UnixLike
includessudoersd = forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
fileProperty ([Char]
sudoers forall a. [a] -> [a] -> [a]
++ [Char]
" includes " forall a. [a] -> [a] -> [a]
++ [Char]
sudoersd) [[Char]] -> [[Char]]
addl [Char]
sudoers
	  where
		addl :: [[Char]] -> [[Char]]
addl [[Char]]
content = [[Char]]
content forall a. [a] -> [a] -> [a]
++ 
			if [Char]
l forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]]
content Bool -> Bool -> Bool
&& [Char]
oldl forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]]
content
				then [[Char]
l]
				else []
		l :: [Char]
l = [Char]
"@includedir /etc/sudoers.d"
		oldl :: [Char]
oldl = [Char]
"#includedir /etc/sudoers.d"

	sudoers :: [Char]
sudoers = [Char]
"/etc/sudoers"
	sudoersd :: [Char]
sudoersd = [Char]
"/etc/sudoers.d"
	dfile :: [Char]
dfile = [Char]
"/etc/sudoers.d/000users"
	sudobaseline :: [Char]
sudobaseline = [Char]
u forall a. [a] -> [a] -> [a]
++ [Char]
" ALL=(ALL:ALL)"
	notuserline :: [Char] -> Bool
notuserline [Char]
l = Bool -> Bool
not ([Char]
sudobaseline forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l)
	sudoline :: Bool -> [Char]
sudoline Bool
True = [Char]
sudobaseline forall a. [a] -> [a] -> [a]
++ [Char]
" NOPASSWD:ALL"
	sudoline Bool
False = [Char]
sudobaseline forall a. [a] -> [a] -> [a]
++ [Char]
" ALL"
	wanted :: Bool -> [Char] -> Bool
wanted Bool
locked [Char]
l
		| [Char] -> Bool
notuserline [Char]
l = Bool
True
		| [Char]
"NOPASSWD" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
l = Bool
locked
		| Bool
otherwise = Bool
True
	modify :: Bool -> [[Char]] -> [[Char]]
modify Bool
locked [[Char]]
ls
		| Bool -> [Char]
sudoline Bool
locked forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
ls = [[Char]]
ls
		| Bool
otherwise = [[Char]]
ls forall a. [a] -> [a] -> [a]
++ [Bool -> [Char]
sudoline Bool
locked]

-- | Sets up a file in /etc/sudoers.d/, which /etc/sudoers includes,
-- with the specified content.
--
-- The FilePath can be relative to that directory.
sudoersDFile :: FilePath -> [Line] -> RevertableProperty DebianLike Linux
sudoersDFile :: [Char] -> [[Char]] -> RevertableProperty DebianLike Linux
sudoersDFile [Char]
dfile [[Char]]
content = Property UnixLike
setup forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [[Char]] -> Property DebianLike
Apt.installed [[Char]
"sudo"] forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property Linux
cleanup
  where
	f :: [Char]
f = [Char]
"/etc/sudoers.d" [Char] -> [Char] -> [Char]
</> [Char]
dfile
	-- sudoers.d files should not be world readable
	setup :: Property UnixLike
setup = [Char] -> [[Char]] -> Property UnixLike
hasContentProtected [Char]
f [[Char]]
content
	cleanup :: Property Linux
cleanup = 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
$ [Char] -> Property UnixLike
notPresent [Char]
f