summaryrefslogtreecommitdiff
path: root/Property
diff options
context:
space:
mode:
authorJoey Hess2014-03-30 15:31:57 -0400
committerJoey Hess2014-03-30 15:38:08 -0400
commit90efcd3203d64c2c5691e30ccc23307aae8d20c8 (patch)
tree183f38a857a81a3cb1a301b94f827f8a807dc961 /Property
parent8d31a6226ac9e1dfc75ec7521f039a43e749ed82 (diff)
refactor
Diffstat (limited to 'Property')
-rw-r--r--Property/Apt.hs7
-rw-r--r--Property/Cmd.hs28
-rw-r--r--Property/File.hs26
-rw-r--r--Property/GitHome.hs15
-rw-r--r--Property/Hostname.hs3
-rw-r--r--Property/Reboot.hs2
-rw-r--r--Property/Ssh.hs12
-rw-r--r--Property/Tor.hs3
-rw-r--r--Property/User.hs7
9 files changed, 59 insertions, 44 deletions
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