module Propellor.Property.Cron (
	Times(..),
	job,
	niceJob,
	jobDropped,
	Propellor.Property.Cron.runPropellor
) where

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

import Data.Char

-- | When to run a cron job.
--
-- The Daily, Monthly, and Weekly options allow the cron job to be run
-- by anacron, which is useful for non-servers.
data Times
	= Times String -- ^ formatted as in crontab(5)
	| Daily
	| Weekly
	| Monthly

-- | Installs a cron job, that will run as a specified user in a particular
-- directory. Note that the Desc must be unique, as it is used for the
-- cron job filename.
--
-- Only one instance of the cron job is allowed to run at a time, no matter
-- how long it runs. This is accomplished using flock locking of the cron
-- job file.
--
-- The cron job's output will only be emailed if it exits nonzero.
job :: Desc -> Times -> User -> FilePath -> String -> Property DebianLike
job :: Desc -> Times -> User -> Desc -> Desc -> Property DebianLike
job desc :: Desc
desc times :: Times
times (User u :: Desc
u) cddir :: Desc
cddir command :: Desc
command = Desc -> Props DebianLike -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties ("cronned " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
desc) (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	Props UnixLike
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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))
& Desc -> Property DebianLike
Apt.serviceInstalledRunning "cron"
	Props DebianLike
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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))
& [Desc] -> Property DebianLike
Apt.installed ["util-linux", "moreutils"]
	Props DebianLike
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& Desc -> Times -> Desc
cronjobfile Desc
desc Times
times Desc -> [Desc] -> Property UnixLike
`File.hasContent`
		[ case Times
times of
			Times _ -> ""
			_ -> "#!/bin/sh\nset -e"
		, "# Generated by propellor"
		, ""
		, "SHELL=/bin/sh"
		, "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
		, ""
		, case Times
times of
			Times t :: Desc
t -> Desc
t Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "\t" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
u Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "\tchronic "
				Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape (Desc -> Desc
scriptfile Desc
desc)
			_ -> case Desc
u of
				"root" -> "chronic " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape (Desc -> Desc
scriptfile Desc
desc)
				_ -> "chronic su " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
u Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ " -c "
					Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape (Desc -> Desc
scriptfile Desc
desc)
		]
	Props DebianLike
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& case Times
times of
		Times _ -> Property UnixLike
forall k (t :: k). SingI t => Property (MetaTypes t)
doNothing
		_ -> (Desc -> Times -> Desc
cronjobfile Desc
desc Times
times)
			Desc -> FileMode -> Property UnixLike
`File.mode` [FileMode] -> FileMode
combineModes ([FileMode]
readModes [FileMode] -> [FileMode] -> [FileMode]
forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes)
	-- Use a separate script because it makes the cron job name
	-- prettier in emails, and also allows running the job manually.
	Props DebianLike
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& Desc -> Desc
scriptfile Desc
desc Desc -> [Desc] -> Property UnixLike
`File.hasContent`
		[ "#!/bin/sh"
		, "# Generated by propellor"
		, "set -e"
		, "flock -n " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape (Desc -> Times -> Desc
cronjobfile Desc
desc Times
times)
			Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ " sh -c " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape Desc
cmdline
		]
	Props DebianLike
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& Desc -> Desc
scriptfile Desc
desc Desc -> FileMode -> Property UnixLike
`File.mode` [FileMode] -> FileMode
combineModes ([FileMode]
readModes [FileMode] -> [FileMode] -> [FileMode]
forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes)
  where
	cmdline :: Desc
cmdline = "cd " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
cddir Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ " && ( " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
command Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ " )"

-- | Removes a cron job created by 'job' or 'niceJob', as identified by the
-- 'Desc' passed to those properties when the cronjob was set up
--
-- Those properties are not revertable because simply removing a cronjob does
-- not undo the changes it might have made to the system, i.e., 'jobDropped' is
-- not in the general case a reversion of 'job' or 'niceJob'
jobDropped :: Desc -> Times -> Property UnixLike
jobDropped :: Desc -> Times -> Property UnixLike
jobDropped desc :: Desc
desc times :: Times
times = Desc -> Props UnixLike -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties ("uncronned " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
desc) (Props UnixLike -> Property UnixLike)
-> Props UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	Props UnixLike
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& Desc -> Property UnixLike
File.notPresent (Desc -> Desc
scriptfile Desc
desc)
	Props UnixLike
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& Desc -> Property UnixLike
File.notPresent (Desc -> Times -> Desc
cronjobfile Desc
desc Times
times)

-- | Installs a cron job, and runs it niced and ioniced.
niceJob :: Desc -> Times -> User -> FilePath -> String -> Property DebianLike
niceJob :: Desc -> Times -> User -> Desc -> Desc -> Property DebianLike
niceJob desc :: Desc
desc times :: Times
times user :: User
user cddir :: Desc
cddir command :: Desc
command = Desc -> Times -> User -> Desc -> Desc -> Property DebianLike
job Desc
desc Times
times User
user Desc
cddir
	("nice ionice -c 3 sh -c " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape Desc
command)

-- | Installs a cron job to run propellor.
runPropellor :: Times -> RevertableProperty DebianLike UnixLike
runPropellor :: Times -> RevertableProperty DebianLike UnixLike
runPropellor times :: Times
times = Property DebianLike
cronned Property DebianLike
-> Property UnixLike -> RevertableProperty DebianLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
uncronned
  where
	cronned :: Property DebianLike
cronned = Desc
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Maybe System -> Propellor Result)
-> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Desc
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS "propellor cron job" ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
  -> Maybe System -> Propellor Result)
 -> Property DebianLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Maybe System -> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \w :: OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w o :: Maybe System
o -> do
		Bootstrapper
bootstrapper <- Propellor Bootstrapper
getBootstrapper
		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]
w (Property DebianLike -> Propellor Result)
-> Property DebianLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$
			Desc -> Times -> User -> Desc -> Desc -> Property DebianLike
niceJob "propellor" Times
times (Desc -> User
User "root") Desc
localdir
				(Bootstrapper -> Maybe System -> Desc
bootstrapPropellorCommand Bootstrapper
bootstrapper Maybe System
o Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "; ./propellor")
	uncronned :: Property UnixLike
uncronned = Desc -> Times -> Property UnixLike
jobDropped "propellor" Times
times

-- Utility functions

cronjobname :: Desc -> String
cronjobname :: Desc -> Desc
cronjobname d :: Desc
d = (Char -> Char) -> Desc -> Desc
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
sanitize Desc
d
  where
	sanitize :: Char -> Char
sanitize c :: Char
c
		| Char -> Bool
isAlphaNum Char
c = Char
c
		| Bool
otherwise = '_'

scriptfile :: Desc -> FilePath
scriptfile :: Desc -> Desc
scriptfile d :: Desc
d = "/usr/local/bin/" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ (Desc -> Desc
cronjobname Desc
d) Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "_cronjob"

cronjobfile :: Desc -> Times -> FilePath
cronjobfile :: Desc -> Times -> Desc
cronjobfile d :: Desc
d times :: Times
times = "/etc" Desc -> Desc -> Desc
</> Desc
cronjobdir Desc -> Desc -> Desc
</> (Desc -> Desc
cronjobname Desc
d)
  where
	cronjobdir :: Desc
cronjobdir = case Times
times of
		Times _ -> "cron.d"
		Daily -> "cron.daily"
		Weekly -> "cron.weekly"
		Monthly -> "cron.monthly"