property lists
This commit is contained in:
parent
d50e4dedb2
commit
0039fb6b56
28
HostProp.hs
28
HostProp.hs
|
@ -12,11 +12,11 @@ main :: IO ()
|
||||||
main = ensureProperties . getProperties =<< getHostName
|
main = ensureProperties . getProperties =<< getHostName
|
||||||
|
|
||||||
{- This is where the system's HostName, either as returned by uname
|
{- 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. -}
|
- Properties for that system. -}
|
||||||
getProperties :: HostName -> [Property]
|
getProperties :: HostName -> [Property]
|
||||||
getProperties "clam.kitenet.net" = concat
|
getProperties hostname@"clam.kitenet.net" =
|
||||||
[ cleanCloudAtCost
|
[ cleanCloudAtCost hostname
|
||||||
, standardSystem Apt.Unstable
|
, standardSystem Apt.Unstable
|
||||||
-- Clam is a tor bridge.
|
-- Clam is a tor bridge.
|
||||||
, Tor.isBridge
|
, Tor.isBridge
|
||||||
|
@ -30,18 +30,9 @@ getProperties "clam.kitenet.net" = concat
|
||||||
--getProperties "foo" =
|
--getProperties "foo" =
|
||||||
getProperties h = error $ "Unknown host: " ++ h ++ " (perhaps you should specify the real hostname on the command line?)"
|
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
|
-- This is my standard system setup
|
||||||
standardSystem :: Suite -> [Property]
|
standardSystem :: Apt.Suite -> Property
|
||||||
standardSystem suite =
|
standardSystem suite = propertyList "standard system"
|
||||||
[ Apt.stdSourcesList suite `onChange` Apt.upgrade
|
[ Apt.stdSourcesList suite `onChange` Apt.upgrade
|
||||||
, Apt.installed ["etckeeper"]
|
, Apt.installed ["etckeeper"]
|
||||||
, Apt.installed ["ssh"]
|
, Apt.installed ["ssh"]
|
||||||
|
@ -59,3 +50,12 @@ standardSystem suite =
|
||||||
, lineInFile "/etc/sudoers" "joey ALL=(ALL:ALL) NOPASSWD:ALL"
|
, lineInFile "/etc/sudoers" "joey ALL=(ALL:ALL) NOPASSWD:ALL"
|
||||||
, GitHome.installedFor "joey"
|
, 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
|
||||||
|
]
|
||||||
|
|
15
Property.hs
15
Property.hs
|
@ -38,6 +38,16 @@ propertyDesc (FileProperty d _ _) = d
|
||||||
propertyDesc (CmdProperty d _ _ _) = d
|
propertyDesc (CmdProperty d _ _ _) = d
|
||||||
propertyDesc (IOProperty 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 -> [Property] -> Property
|
||||||
combineProperties desc ps = IOProperty desc $ go ps NoChange
|
combineProperties desc ps = IOProperty desc $ go ps NoChange
|
||||||
where
|
where
|
||||||
|
@ -71,10 +81,13 @@ ensureProperty' (IOProperty _ a) = a
|
||||||
|
|
||||||
ensureProperties :: [Property] -> IO ()
|
ensureProperties :: [Property] -> IO ()
|
||||||
ensureProperties ps = do
|
ensureProperties ps = do
|
||||||
r <- ensure ps NoChange
|
r <- ensureProperties' ps
|
||||||
case r of
|
case r of
|
||||||
FailedChange -> exitWith (ExitFailure 1)
|
FailedChange -> exitWith (ExitFailure 1)
|
||||||
_ -> exitWith ExitSuccess
|
_ -> exitWith ExitSuccess
|
||||||
|
|
||||||
|
ensureProperties' :: [Property] -> IO Result
|
||||||
|
ensureProperties' ps = ensure ps NoChange
|
||||||
where
|
where
|
||||||
ensure [] rs = return rs
|
ensure [] rs = return rs
|
||||||
ensure (l:ls) rs = do
|
ensure (l:ls) rs = do
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
module Property.Reboot where
|
module Property.Reboot where
|
||||||
|
|
||||||
import Property
|
import Property
|
||||||
import Utility.SafeCommand
|
|
||||||
|
|
||||||
now -> Property
|
now :: Property
|
||||||
now = cmdProperty "reboot" []
|
now = cmdProperty "reboot" []
|
||||||
|
|
Loading…
Reference in New Issue