From 551a7ec8bd7486ea599271c99236ceffa1743e5a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Mar 2016 14:48:24 -0400 Subject: more porting --- src/Propellor/Property/Gpg.hs | 5 +++-- src/Propellor/Property/Group.hs | 2 +- src/Propellor/Property/Kerberos.hs | 29 +++++++++++++++-------------- src/Propellor/Property/LightDM.hs | 6 ++---- src/Propellor/Property/Locale.hs | 38 +++++++++++++++++++++----------------- src/Propellor/Property/Logcheck.hs | 4 ++-- src/Propellor/Property/Nginx.hs | 14 +++++++------- src/Propellor/Property/Obnam.hs | 17 +++++++++-------- 8 files changed, 60 insertions(+), 55 deletions(-) (limited to 'src/Propellor/Property') 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 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"] -- cgit v1.2.3