From 90efcd3203d64c2c5691e30ccc23307aae8d20c8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Mar 2014 15:31:57 -0400 Subject: refactor --- Property/Apt.hs | 7 +++---- Property/Cmd.hs | 28 ++++++++++++++++++++++++++++ Property/File.hs | 26 ++++++++++++++++++-------- Property/GitHome.hs | 15 +++------------ Property/Hostname.hs | 3 +-- Property/Reboot.hs | 2 +- Property/Ssh.hs | 12 +++--------- Property/Tor.hs | 3 +-- Property/User.hs | 7 +------ 9 files changed, 59 insertions(+), 44 deletions(-) create mode 100644 Property/Cmd.hs (limited to 'Property') diff --git a/Property/Apt.hs b/Property/Apt.hs index 653c0fca..a5720e72 100644 --- a/Property/Apt.hs +++ b/Property/Apt.hs @@ -6,10 +6,9 @@ import Data.List import System.IO import Control.Monad -import Property +import Common import qualified Property.File as File -import Utility.SafeCommand -import Utility.Process +import Property.File (Line) sourcesList :: FilePath sourcesList = "/etc/apt/sources.list" @@ -109,7 +108,7 @@ unattendedUpgrades enabled = installed ["unattended-upgrades"] reConfigure :: Package -> [(String, String, String)] -> Property reConfigure package vals = reconfigure `requires` setselections where - setselections = IOProperty "preseed" $ makeChange $ + setselections = Property "preseed" $ makeChange $ withHandle StdinHandle createProcessSuccess (proc "debconf-set-selections" []) $ \h -> do forM_ vals $ \(template, tmpltype, value) -> diff --git a/Property/Cmd.hs b/Property/Cmd.hs new file mode 100644 index 00000000..c78adaeb --- /dev/null +++ b/Property/Cmd.hs @@ -0,0 +1,28 @@ +module Property.Cmd ( + cmdProperty, + cmdProperty', + module Utility.SafeCommand +) where + +import Control.Applicative + +import Property +import Utility.Monad +import Utility.SafeCommand +import Utility.Env + +cmdProperty :: String -> [CommandParam] -> Property +cmdProperty cmd params = cmdProperty' cmd params [] + +cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property +cmdProperty' cmd params env = Property desc $ do + env' <- addEntries env <$> getEnvironment + ifM (boolSystemEnv cmd params (Just env')) + ( return MadeChange + , return FailedChange + ) + where + desc = unwords $ cmd : map showp params + showp (Params s) = s + showp (Param s) = s + showp (File s) = s diff --git a/Property/File.hs b/Property/File.hs index 9d07f130..55ca4fec 100644 --- a/Property/File.hs +++ b/Property/File.hs @@ -1,18 +1,17 @@ module Property.File where -import System.Directory +import Common -import Property -import Utility.Directory +type Line = String {- Replaces all the content of a file. -} hasContent :: FilePath -> [Line] -> Property -f `hasContent` newcontent = FileProperty ("replace " ++ f) - f (\_oldcontent -> newcontent) +f `hasContent` newcontent = fileProperty ("replace " ++ f) + (\_oldcontent -> newcontent) f {- Ensures that a line is present in a file, adding it to the end if not. -} containsLine :: FilePath -> Line -> Property -f `containsLine` l = FileProperty (f ++ " contains:" ++ l) f go +f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f where go ls | l `elem` ls = ls @@ -22,9 +21,20 @@ f `containsLine` l = FileProperty (f ++ " contains:" ++ l) f go - Note that the file is ensured to exist, so if it doesn't, an empty - file will be written. -} lacksLine :: FilePath -> Line -> Property -f `lacksLine` l = FileProperty (f ++ " remove: " ++ l) f (filter (/= l)) +f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f {- Note: Does not remove symlinks or non-plain-files. -} notPresent :: FilePath -> Property -notPresent f = check (doesFileExist f) $ IOProperty (f ++ " not present") $ +notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $ makeChange $ nukeFile f + +fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property +fileProperty desc a f = Property desc $ go =<< doesFileExist f + where + go True = do + ls <- lines <$> catchDefaultIO [] (readFile f) + let ls' = a ls + if ls' == ls + then noChange + else makeChange $ viaTmp writeFile f (unlines ls') + go False = makeChange $ writeFile f (unlines $ a []) diff --git a/Property/GitHome.hs b/Property/GitHome.hs index 09d21326..99402b8e 100644 --- a/Property/GitHome.hs +++ b/Property/GitHome.hs @@ -1,22 +1,13 @@ module Property.GitHome where -import System.FilePath -import System.Directory -import Control.Applicative -import Control.Monad - -import Property -import Property.User -import Utility.SafeCommand -import Utility.Directory -import Utility.Monad -import Utility.Exception +import Common import qualified Property.Apt as Apt +import Property.User {- Clones Joey Hess's git home directory, and runs its fixups script. -} installedFor :: UserName -> Property installedFor user = check (not <$> hasGitDir user) $ - IOProperty ("githome " ++ user) (go =<< homedir user) + Property ("githome " ++ user) (go =<< homedir user) `requires` Apt.installed ["git", "myrepos"] where go Nothing = noChange diff --git a/Property/Hostname.hs b/Property/Hostname.hs index 38e9dbe8..8bc7a6b8 100644 --- a/Property/Hostname.hs +++ b/Property/Hostname.hs @@ -1,8 +1,7 @@ module Property.Hostname where -import Property +import Common import qualified Property.File as File -import Utility.SafeCommand type HostName = String diff --git a/Property/Reboot.hs b/Property/Reboot.hs index b6e3030e..79aa6010 100644 --- a/Property/Reboot.hs +++ b/Property/Reboot.hs @@ -1,6 +1,6 @@ module Property.Reboot where -import Property +import Common now :: Property now = cmdProperty "reboot" [] diff --git a/Property/Ssh.hs b/Property/Ssh.hs index 98149bcb..1b0a6c53 100644 --- a/Property/Ssh.hs +++ b/Property/Ssh.hs @@ -1,14 +1,8 @@ module Property.Ssh where -import Control.Applicative -import Control.Monad -import System.FilePath - -import Property -import Property.User +import Common import qualified Property.File as File -import Utility.SafeCommand -import Utility.Exception +import Property.User sshBool :: Bool -> String sshBool True = "yes" @@ -48,7 +42,7 @@ uniqueHostKeys :: Property uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" `onChange` restartSshd where - prop = IOProperty "ssh unique host keys" $ do + prop = Property "ssh unique host keys" $ do void $ boolSystem "sh" [ Param "-c" , Param "rm -f /etc/ssh/ssh_host_*" diff --git a/Property/Tor.hs b/Property/Tor.hs index 7f7e7245..a4184edf 100644 --- a/Property/Tor.hs +++ b/Property/Tor.hs @@ -1,7 +1,6 @@ module Property.Tor where -import Property -import Utility.SafeCommand +import Common import qualified Property.File as File import qualified Property.Apt as Apt diff --git a/Property/User.hs b/Property/User.hs index 3cd74964..733e26ea 100644 --- a/Property/User.hs +++ b/Property/User.hs @@ -1,13 +1,8 @@ module Property.User where import System.Posix -import Control.Applicative -import Data.Maybe -import Property -import Utility.SafeCommand -import Utility.Exception -import Utility.Process +import Common type UserName = String -- cgit v1.2.3