property lists

This commit is contained in:
Joey Hess 2014-03-30 02:26:23 -04:00
parent d50e4dedb2
commit 0039fb6b56
3 changed files with 29 additions and 17 deletions

View File

@ -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
]

View File

@ -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

View File

@ -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" []