summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Gpg.hs5
-rw-r--r--src/Propellor/Property/Group.hs2
-rw-r--r--src/Propellor/Property/Kerberos.hs29
-rw-r--r--src/Propellor/Property/LightDM.hs6
-rw-r--r--src/Propellor/Property/Locale.hs38
-rw-r--r--src/Propellor/Property/Logcheck.hs4
-rw-r--r--src/Propellor/Property/Nginx.hs14
-rw-r--r--src/Propellor/Property/Obnam.hs17
8 files changed, 60 insertions, 55 deletions
diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs
index bd710ca7..74e9df5a 100644
--- a/src/Propellor/Property/Gpg.hs
+++ b/src/Propellor/Property/Gpg.hs
@@ -6,7 +6,7 @@ import Utility.FileSystemEncoding
import System.PosixCompat
-installed :: Property NoInfo
+installed :: Property DebianLike
installed = Apt.installed ["gnupg"]
-- A numeric id, or a description of the key, in a form understood by gpg.
@@ -22,11 +22,12 @@ data GpgKeyType = GpgPubKey | GpgPrivKey
--
-- Recommend only using this for low-value dedicated role keys.
-- No attempt has been made to scrub the key out of memory once it's used.
-keyImported :: GpgKeyId -> User -> Property HasInfo
+keyImported :: GpgKeyId -> User -> Property (HasInfo + DebianLike)
keyImported key@(GpgKeyId keyid) user@(User u) = prop
`requires` installed
where
desc = u ++ " has gpg key " ++ show keyid
+ prop :: Property (HasInfo + DebianLike)
prop = withPrivData src (Context keyid) $ \getkey ->
property desc $ getkey $ \key' -> do
let keylines = privDataLines key'
diff --git a/src/Propellor/Property/Group.hs b/src/Propellor/Property/Group.hs
index f91ef1c2..58e49a86 100644
--- a/src/Propellor/Property/Group.hs
+++ b/src/Propellor/Property/Group.hs
@@ -4,7 +4,7 @@ import Propellor.Base
type GID = Int
-exists :: Group -> Maybe GID -> Property NoInfo
+exists :: Group -> Maybe GID -> Property UnixLike
exists (Group group') mgid = check test (cmdProperty "addgroup" (args mgid))
`describe` unwords ["group", group']
where
diff --git a/src/Propellor/Property/Kerberos.hs b/src/Propellor/Property/Kerberos.hs
index cb6e06cc..3c351943 100644
--- a/src/Propellor/Property/Kerberos.hs
+++ b/src/Propellor/Property/Kerberos.hs
@@ -34,25 +34,25 @@ keyTabPath = maybe defaultKeyTab id
principal :: String -> Maybe String -> Maybe Realm -> Principal
principal p i r = p ++ maybe "" ("/"++) i ++ maybe "" ("@" ++) r
-installed :: Property NoInfo
+installed :: Property DebianLike
installed = Apt.installed ["krb5-user"]
-kdcInstalled :: Property NoInfo
+kdcInstalled :: Property DebianLike
kdcInstalled = Apt.serviceInstalledRunning "krb5-kdc"
-adminServerInstalled :: Property NoInfo
+adminServerInstalled :: Property DebianLike
adminServerInstalled = Apt.serviceInstalledRunning "krb5-admin-server"
-kpropServerInstalled :: Property HasInfo
+kpropServerInstalled :: Property DebianLike
kpropServerInstalled = propertyList "kprop server installed" $ props
& kdcInstalled
& Apt.installed ["openbsd-inetd"]
& "/etc/inetd.conf" `File.containsLines`
- [ "krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd"
- , "krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd"
- ]
+ [ "krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd"
+ , "krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd"
+ ]
-kpropAcls :: [String] -> Property NoInfo
+kpropAcls :: [String] -> Property UnixLike
kpropAcls ps = kpropdAclPath `File.hasContent` ps `describe` "kprop server ACLs"
k5srvutil :: (Maybe FilePath) -> [String] -> IO String
@@ -82,13 +82,14 @@ k5loginPath user = do
h <- homedir user
return $ h </> ".k5login"
-k5login :: User -> [Principal] -> Property NoInfo
-k5login user@(User u) ps = property (u ++ " has k5login") $ do
+k5login :: User -> [Principal] -> Property UnixLike
+k5login user@(User u) ps = property' desc $ \w -> do
f <- liftIO $ k5loginPath user
liftIO $ do
createDirectoryIfMissing True (takeDirectory f)
writeFile f (unlines ps)
- ensureProperties
- [ File.ownerGroup f user (userGroup user)
- , File.ownerGroup (takeDirectory f) user (userGroup user)
- ]
+ ensureProperty w $ combineProperties desc $ props
+ & File.ownerGroup f user (userGroup user)
+ & File.ownerGroup (takeDirectory f) user (userGroup user)
+ where
+ desc = u ++ " has k5login"
diff --git a/src/Propellor/Property/LightDM.hs b/src/Propellor/Property/LightDM.hs
index 75e3b19a..339fa9a3 100644
--- a/src/Propellor/Property/LightDM.hs
+++ b/src/Propellor/Property/LightDM.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE FlexibleInstances #-}
-
-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
module Propellor.Property.LightDM where
@@ -8,11 +6,11 @@ import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.ConfFile as ConfFile
-installed :: Property NoInfo
+installed :: Property DebianLike
installed = Apt.installed ["lightdm"]
-- | Configures LightDM to skip the login screen and autologin as a user.
-autoLogin :: User -> Property NoInfo
+autoLogin :: User -> Property UnixLike
autoLogin (User u) = "/etc/lightdm/lightdm.conf" `ConfFile.containsIniSetting`
("SeatDefaults", "autologin-user", u)
`describe` "lightdm autologin"
diff --git a/src/Propellor/Property/Locale.hs b/src/Propellor/Property/Locale.hs
index 06cd63ad..b7cf242c 100644
--- a/src/Propellor/Property/Locale.hs
+++ b/src/Propellor/Property/Locale.hs
@@ -21,14 +21,17 @@ type LocaleVariable = String
--
-- Note that reverting this property does not make a locale unavailable. That's
-- because it might be required for other Locale.selectedFor statements.
-selectedFor :: Locale -> [LocaleVariable] -> RevertableProperty NoInfo
+selectedFor :: Locale -> [LocaleVariable] -> RevertableProperty DebianLike DebianLike
locale `selectedFor` vars = select <!> deselect
where
- select = check (not <$> isselected) (cmdProperty "update-locale" selectArgs)
- `requires` available locale
- `describe` (locale ++ " locale selected")
- deselect = check isselected (cmdProperty "update-locale" vars)
- `describe` (locale ++ " locale deselected")
+ select = tightenTargets $
+ check (not <$> isselected)
+ (cmdProperty "update-locale" selectArgs)
+ `requires` available locale
+ `describe` (locale ++ " locale selected")
+ deselect = tightenTargets $
+ check isselected (cmdProperty "update-locale" vars)
+ `describe` (locale ++ " locale deselected")
selectArgs = zipWith (++) vars (repeat ('=':locale))
isselected = locale `isSelectedFor` vars
@@ -46,20 +49,21 @@ locale `isSelectedFor` vars = do
--
-- Per Debian bug #684134 we cannot ensure a locale is generated by means of
-- Apt.reConfigure. So localeAvailable edits /etc/locale.gen manually.
-available :: Locale -> RevertableProperty NoInfo
-available locale = (ensureAvailable <!> ensureUnavailable)
+available :: Locale -> RevertableProperty DebianLike DebianLike
+available locale = ensureAvailable <!> ensureUnavailable
where
f = "/etc/locale.gen"
desc = (locale ++ " locale generated")
- ensureAvailable =
- property desc $ (lines <$> (liftIO $ readFile f))
- >>= \locales ->
- if locale `presentIn` locales
- then ensureProperty $
- fileProperty desc (foldr uncomment []) f
- `onChange` regenerate
- else return FailedChange -- locale unavailable for generation
- ensureUnavailable =
+ ensureAvailable :: Property DebianLike
+ ensureAvailable = property' desc $ \w -> do
+ locales <- lines <$> (liftIO $ readFile f)
+ if locale `presentIn` locales
+ then ensureProperty w $
+ fileProperty desc (foldr uncomment []) f
+ `onChange` regenerate
+ else return FailedChange -- locale unavailable for generation
+ ensureUnavailable :: Property DebianLike
+ ensureUnavailable = tightenTargets $
fileProperty (locale ++ " locale not generated") (foldr comment []) f
`onChange` regenerate
diff --git a/src/Propellor/Property/Logcheck.hs b/src/Propellor/Property/Logcheck.hs
index 22621cc2..ced9fce2 100644
--- a/src/Propellor/Property/Logcheck.hs
+++ b/src/Propellor/Property/Logcheck.hs
@@ -28,9 +28,9 @@ defaultPrefix = "^\\w{3} [ :[:digit:]]{11} [._[:alnum:]-]+ "
ignoreFilePath :: ReportLevel -> Service -> FilePath
ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (show t) </> n
-ignoreLines :: ReportLevel -> Service -> [String] -> Property NoInfo
+ignoreLines :: ReportLevel -> Service -> [String] -> Property UnixLike
ignoreLines t n ls = (ignoreFilePath t n) `File.containsLines` ls
`describe` ("logcheck ignore lines for " ++ n ++ "(" ++ (show t) ++ ")")
-installed :: Property NoInfo
+installed :: Property DebianLike
installed = Apt.installed ["logcheck"]
diff --git a/src/Propellor/Property/Nginx.hs b/src/Propellor/Property/Nginx.hs
index 8fb5c49b..e40ba657 100644
--- a/src/Propellor/Property/Nginx.hs
+++ b/src/Propellor/Property/Nginx.hs
@@ -9,7 +9,7 @@ import qualified Propellor.Property.Service as Service
type ConfigFile = [String]
-siteEnabled :: HostName -> ConfigFile -> RevertableProperty NoInfo
+siteEnabled :: HostName -> ConfigFile -> RevertableProperty DebianLike DebianLike
siteEnabled hn cf = enable <!> disable
where
enable = siteVal hn `File.isSymlinkedTo` siteValRelativeCfg hn
@@ -22,11 +22,11 @@ siteEnabled hn cf = enable <!> disable
`requires` installed
`onChange` reloaded
-siteAvailable :: HostName -> ConfigFile -> Property NoInfo
-siteAvailable hn cf = ("nginx site available " ++ hn) ==>
- siteCfg hn `File.hasContent` (comment : cf)
+siteAvailable :: HostName -> ConfigFile -> Property DebianLike
+siteAvailable hn cf = "nginx site available " ++ hn ==> tightenTargets go
where
comment = "# deployed with propellor, do not modify"
+ go = siteCfg hn `File.hasContent` (comment : cf)
siteCfg :: HostName -> FilePath
siteCfg hn = "/etc/nginx/sites-available/" ++ hn
@@ -37,11 +37,11 @@ siteVal hn = "/etc/nginx/sites-enabled/" ++ hn
siteValRelativeCfg :: HostName -> File.LinkTarget
siteValRelativeCfg hn = File.LinkTarget ("../sites-available/" ++ hn)
-installed :: Property NoInfo
+installed :: Property DebianLike
installed = Apt.installed ["nginx"]
-restarted :: Property NoInfo
+restarted :: Property DebianLike
restarted = Service.restarted "nginx"
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
reloaded = Service.reloaded "nginx"
diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs
index 666328ac..6d6f4a7f 100644
--- a/src/Propellor/Property/Obnam.hs
+++ b/src/Propellor/Property/Obnam.hs
@@ -40,7 +40,7 @@ data NumClients = OnlyClient | MultipleClients
-- Since obnam uses a fair amount of system resources, only one obnam
-- backup job will be run at a time. Other jobs will wait their turns to
-- run.
-backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property NoInfo
+backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike
backup dir crontimes params numclients =
backup' dir crontimes params numclients
`requires` restored dir params
@@ -50,7 +50,7 @@ backup dir crontimes params numclients =
--
-- The gpg secret key will be automatically imported
-- into root's keyring using Propellor.Property.Gpg.keyImported
-backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property HasInfo
+backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property (HasInfo + DebianLike)
backupEncrypted dir crontimes params numclients keyid =
backup dir crontimes params' numclients
`requires` Gpg.keyImported keyid (User "root")
@@ -58,7 +58,7 @@ backupEncrypted dir crontimes params numclients keyid =
params' = ("--encrypt-with=" ++ Gpg.getGpgKeyId keyid) : params
-- | Does a backup, but does not automatically restore.
-backup' :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property NoInfo
+backup' :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike
backup' dir crontimes params numclients = cronjob `describe` desc
where
desc = dir ++ " backed up by obnam"
@@ -96,11 +96,12 @@ backup' dir crontimes params numclients = cronjob `describe` desc
--
-- The restore is performed atomically; restoring to a temp directory
-- and then moving it to the directory.
-restored :: FilePath -> [ObnamParam] -> Property NoInfo
-restored dir params = property (dir ++ " restored by obnam") go
- `requires` installed
+restored :: FilePath -> [ObnamParam] -> Property DebianLike
+restored dir params = go `requires` installed
where
- go = ifM (liftIO needsRestore)
+ desc = dir ++ " restored by obnam"
+ go :: Property DebianLike
+ go = property desc $ ifM (liftIO needsRestore)
( do
warningMessage $ dir ++ " is empty/missing; restoring from backup ..."
liftIO restore
@@ -152,5 +153,5 @@ keepParam ps = "--keep=" ++ intercalate "," (map go ps)
isKeepParam :: ObnamParam -> Bool
isKeepParam p = "--keep=" `isPrefixOf` p
-installed :: Property NoInfo
+installed :: Property DebianLike
installed = Apt.installed ["obnam"]