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 Times
times (User Desc
u) Desc
cddir Desc
command = forall {k} (metatypes :: k).
SingI metatypes =>
Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Desc
"cronned " forall a. [a] -> [a] -> [a]
++ Desc
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))
& Desc -> Property DebianLike
Apt.serviceInstalledRunning Desc
"cron"
	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 [Desc
"util-linux", Desc
"moreutils"]
	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 Desc
_ -> Desc
""
			Times
_ -> Desc
"#!/bin/sh\nset -e"
		, Desc
"# Generated by propellor"
		, Desc
""
		, Desc
"SHELL=/bin/sh"
		, Desc
"PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
		, Desc
""
		, case Times
times of
			Times Desc
t -> Desc
t forall a. [a] -> [a] -> [a]
++ Desc
"\t" forall a. [a] -> [a] -> [a]
++ Desc
u forall a. [a] -> [a] -> [a]
++ Desc
"\tchronic "
				forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape (Desc -> Desc
scriptfile Desc
desc)
			Times
_ -> case Desc
u of
				Desc
"root" -> Desc
"chronic " forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape (Desc -> Desc
scriptfile Desc
desc)
				Desc
_ -> Desc
"chronic su " forall a. [a] -> [a] -> [a]
++ Desc
u forall a. [a] -> [a] -> [a]
++ Desc
" -c "
					forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape (Desc -> Desc
scriptfile Desc
desc)
		]
	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 Desc
_ -> forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing
		Times
_ -> (Desc -> Times -> Desc
cronjobfile Desc
desc Times
times)
			Desc -> FileMode -> Property UnixLike
`File.mode` [FileMode] -> FileMode
combineModes ([FileMode]
readModes 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.
	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`
		[ Desc
"#!/bin/sh"
		, Desc
"# Generated by propellor"
		, Desc
"set -e"
		, Desc
"flock -n " forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape (Desc -> Times -> Desc
cronjobfile Desc
desc Times
times)
			forall a. [a] -> [a] -> [a]
++ Desc
" sh -c " forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape Desc
cmdline
		]
	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 forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes)
  where
	cmdline :: Desc
cmdline = Desc
"cd " forall a. [a] -> [a] -> [a]
++ Desc
cddir forall a. [a] -> [a] -> [a]
++ Desc
" && ( " forall a. [a] -> [a] -> [a]
++ Desc
command forall a. [a] -> [a] -> [a]
++ Desc
" )"

-- | 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 Times
times = forall {k} (metatypes :: k).
SingI metatypes =>
Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Desc
"uncronned " forall a. [a] -> [a] -> [a]
++ Desc
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))
& Desc -> Property UnixLike
File.notPresent (Desc -> Desc
scriptfile Desc
desc)
	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 Times
times User
user Desc
cddir Desc
command = Desc -> Times -> User -> Desc -> Desc -> Property DebianLike
job Desc
desc Times
times User
user Desc
cddir
	(Desc
"nice ionice -c 3 sh -c " 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 = Property DebianLike
cronned forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
uncronned
  where
	cronned :: Property DebianLike
cronned = forall {k} (metatypes :: k).
SingI metatypes =>
Desc
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS Desc
"propellor cron job" forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w Maybe System
o -> do
		Bootstrapper
bootstrapper <- Propellor Bootstrapper
getBootstrapper
		forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$
			Desc -> Times -> User -> Desc -> Desc -> Property DebianLike
niceJob Desc
"propellor" Times
times (Desc -> User
User Desc
"root") Desc
localdir
				(Bootstrapper -> Maybe System -> Desc
bootstrapPropellorCommand Bootstrapper
bootstrapper Maybe System
o forall a. [a] -> [a] -> [a]
++ Desc
"; ./propellor")
	uncronned :: Property UnixLike
uncronned = Desc -> Times -> Property UnixLike
jobDropped Desc
"propellor" Times
times

-- Utility functions

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

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

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