{-# LANGUAGE DeriveDataTypeable #-}

module Propellor.Property.Service where

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

type ServiceName = String

-- | Ensures that a service is running. Does not ensure that
-- any package providing that service is installed. See
-- Apt.serviceInstalledRunning
--
-- Note that due to the general poor state of init scripts, the best
-- we can do is try to start the service, and if it fails, assume
-- this means it's already running.
running :: ServiceName -> Property DebianLike
running :: ServiceName -> Property DebianLike
running = ServiceName -> ServiceName -> ServiceName -> Property DebianLike
signaled ServiceName
"start" ServiceName
"running"

restarted :: ServiceName -> Property DebianLike
restarted :: ServiceName -> Property DebianLike
restarted = ServiceName -> ServiceName -> ServiceName -> Property DebianLike
signaled ServiceName
"restart" ServiceName
"restarted"

reloaded :: ServiceName -> Property DebianLike
reloaded :: ServiceName -> Property DebianLike
reloaded = ServiceName -> ServiceName -> ServiceName -> Property DebianLike
signaled ServiceName
"reload" ServiceName
"reloaded"

signaled :: String -> Desc -> ServiceName -> Property DebianLike
signaled :: ServiceName -> ServiceName -> ServiceName -> Property DebianLike
signaled ServiceName
cmd ServiceName
desc ServiceName
svc = 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
<$> Propellor Bool
servicesDisabled) forall a b. (a -> b) -> a -> b
$
	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
$ Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
p forall p. IsProp p => p -> ServiceName -> p
`describe` (ServiceName
desc forall a. [a] -> [a] -> [a]
++ ServiceName
" " forall a. [a] -> [a] -> [a]
++ ServiceName
svc)
  where
	p :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
p = Script
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
scriptProperty [ServiceName
"service " forall a. [a] -> [a] -> [a]
++ ServiceName -> ServiceName
shellEscape ServiceName
svc forall a. [a] -> [a] -> [a]
++ ServiceName
" " forall a. [a] -> [a] -> [a]
++ ServiceName
cmd forall a. [a] -> [a] -> [a]
++ ServiceName
" >/dev/null 2>&1 || true"]
		forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange

-- | This property prevents daemons and other services from being started,
-- which is often something you want to prevent when building a chroot.
--
-- When this is set, `running` and `restarted` will not start services.
--
-- On Debian this installs a </usr/sbin/policy-rc.d> script to further
-- prevent any packages that get installed from starting daemons.
-- Reverting the property removes the script.
noServices :: RevertableProperty (HasInfo + UnixLike) UnixLike
noServices :: RevertableProperty
  (HasInfo
   + MetaTypes
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
noServices = (Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` forall v. IsInfo v => v -> Info
toInfo (forall v. v -> InfoVal v
InfoVal NoServices
NoServices)) forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
teardown
  where
	f :: ServiceName
f = ServiceName
"/usr/sbin/policy-rc.d"
	script :: Script
script = [ ServiceName
"#!/bin/sh", ServiceName
"exit 101" ]
	setup :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup = forall {k} (metatypes :: k).
SingI metatypes =>
ServiceName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties ServiceName
"no services started" forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps
		[ ServiceName
-> Script
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.hasContent ServiceName
f Script
script
		, ServiceName
-> FileMode
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.mode ServiceName
f ([FileMode] -> FileMode
combineModes ([FileMode]
readModes forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes))
		]
	teardown :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
teardown = ServiceName
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent ServiceName
f

-- | Check if the noServices property is in effect.
servicesDisabled :: Propellor Bool
servicesDisabled :: Propellor Bool
servicesDisabled = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. InfoVal v -> Maybe v
fromInfoVal
	forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall v. IsInfo v => Propellor v
askInfo :: Propellor (InfoVal NoServices))

data NoServices = NoServices deriving (NoServices -> NoServices -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoServices -> NoServices -> Bool
$c/= :: NoServices -> NoServices -> Bool
== :: NoServices -> NoServices -> Bool
$c== :: NoServices -> NoServices -> Bool
Eq, Int -> NoServices -> ServiceName -> ServiceName
[NoServices] -> ServiceName -> ServiceName
NoServices -> ServiceName
forall a.
(Int -> a -> ServiceName -> ServiceName)
-> (a -> ServiceName)
-> ([a] -> ServiceName -> ServiceName)
-> Show a
showList :: [NoServices] -> ServiceName -> ServiceName
$cshowList :: [NoServices] -> ServiceName -> ServiceName
show :: NoServices -> ServiceName
$cshow :: NoServices -> ServiceName
showsPrec :: Int -> NoServices -> ServiceName -> ServiceName
$cshowsPrec :: Int -> NoServices -> ServiceName -> ServiceName
Show, Typeable)