summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-03-30 02:26:23 -0400
committerJoey Hess2014-03-30 02:28:08 -0400
commit0039fb6b5623fc7a690fa2a2d3fe20214de236d6 (patch)
treea262465f02d245943e943cd91926992660e46713
parentd50e4dedb20054877916191d66d537defb738667 (diff)
property lists
-rw-r--r--HostProp.hs28
-rw-r--r--Property.hs15
-rw-r--r--Property/Reboot.hs3
3 files changed, 29 insertions, 17 deletions
diff --git a/HostProp.hs b/HostProp.hs
index 152ad5a0..494498dc 100644
--- a/HostProp.hs
+++ b/HostProp.hs
@@ -12,11 +12,11 @@ main :: IO ()
main = ensureProperties . getProperties =<< getHostName
{- This is where the system's HostName, either as returned by uname
- - or one specified on the command line is converted into a list of
+ - or one specified on the command line, is converted into a list of
- Properties for that system. -}
getProperties :: HostName -> [Property]
-getProperties "clam.kitenet.net" = concat
- [ cleanCloudAtCost
+getProperties hostname@"clam.kitenet.net" =
+ [ cleanCloudAtCost hostname
, standardSystem Apt.Unstable
-- Clam is a tor bridge.
, Tor.isBridge
@@ -30,18 +30,9 @@ getProperties "clam.kitenet.net" = concat
--getProperties "foo" =
getProperties h = error $ "Unknown host: " ++ h ++ " (perhaps you should specify the real hostname on the command line?)"
--- Clean up the system as installed by cloudatcost.com
-cleanCloudAtCost :: [Property]
-cleanCloudAtCost =
- [ User.nuked "user"
- , Apt.removed ["exim4"] `onChange` Apt.autoRemove
- , Hostname.set "clam.kitenet.net"
- , Ssh.uniqueHostKeys
- ]
-
-- This is my standard system setup
-standardSystem :: Suite -> [Property]
-standardSystem suite =
+standardSystem :: Apt.Suite -> Property
+standardSystem suite = propertyList "standard system"
[ Apt.stdSourcesList suite `onChange` Apt.upgrade
, Apt.installed ["etckeeper"]
, Apt.installed ["ssh"]
@@ -59,3 +50,12 @@ standardSystem suite =
, lineInFile "/etc/sudoers" "joey ALL=(ALL:ALL) NOPASSWD:ALL"
, GitHome.installedFor "joey"
]
+
+-- Clean up a system as installed by cloudatcost.com
+cleanCloudAtCost :: HostName -> Property
+cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"
+ [ User.nuked "user"
+ , Apt.removed ["exim4"] `onChange` Apt.autoRemove
+ , Hostname.set hostname
+ , Ssh.uniqueHostKeys
+ ]
diff --git a/Property.hs b/Property.hs
index 6a6bb3b7..f7dcccde 100644
--- a/Property.hs
+++ b/Property.hs
@@ -38,6 +38,16 @@ propertyDesc (FileProperty d _ _) = d
propertyDesc (CmdProperty d _ _ _) = d
propertyDesc (IOProperty d _) = d
+{- Combines a list of properties, resulting in a single property
+ - that when run will run each property in the list in turn,
+ - and print out the description of each as it's run. Does not stop
+ - on failure; does propigate overall success/failure.
+ -}
+propertyList :: Desc -> [Property] -> Property
+propertyList desc ps = IOProperty desc $ ensureProperties' ps
+
+{- Combines a list of properties, resulting in one property that
+ - ensures each in turn, stopping on failure. -}
combineProperties :: Desc -> [Property] -> Property
combineProperties desc ps = IOProperty desc $ go ps NoChange
where
@@ -71,10 +81,13 @@ ensureProperty' (IOProperty _ a) = a
ensureProperties :: [Property] -> IO ()
ensureProperties ps = do
- r <- ensure ps NoChange
+ r <- ensureProperties' ps
case r of
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
+
+ensureProperties' :: [Property] -> IO Result
+ensureProperties' ps = ensure ps NoChange
where
ensure [] rs = return rs
ensure (l:ls) rs = do
diff --git a/Property/Reboot.hs b/Property/Reboot.hs
index 63987ad3..b6e3030e 100644
--- a/Property/Reboot.hs
+++ b/Property/Reboot.hs
@@ -1,7 +1,6 @@
module Property.Reboot where
import Property
-import Utility.SafeCommand
-now -> Property
+now :: Property
now = cmdProperty "reboot" []