From c97285a21ea0e392e8c63c1898ee2deeb34e99a0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 13 Apr 2014 02:28:40 -0400 Subject: propellor spin --- Propellor/Types/Attr.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'Propellor/Types') diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs index c253e32b..cdbe9ca3 100644 --- a/Propellor/Types/Attr.hs +++ b/Propellor/Types/Attr.hs @@ -6,6 +6,7 @@ import qualified Data.Set as S data Attr = Attr { _hostname :: HostName , _cnames :: S.Set Domain + , _sshPubKey :: Maybe String , _dockerImage :: Maybe String , _dockerRunParams :: [HostName -> String] @@ -15,6 +16,7 @@ instance Eq Attr where x == y = and [ _hostname x == _hostname y , _cnames x == _cnames y + , _sshPubKey x == _sshPubKey y , _dockerImage x == _dockerImage y , let simpl v = map (\a -> a "") (_dockerRunParams v) @@ -25,12 +27,13 @@ instance Show Attr where show a = unlines [ "hostname " ++ _hostname a , "cnames " ++ show (_cnames a) + , "sshPubKey " ++ show (_sshPubKey a) , "docker image " ++ show (_dockerImage a) , "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a)) ] newAttr :: HostName -> Attr -newAttr hn = Attr hn S.empty Nothing [] +newAttr hn = Attr hn S.empty Nothing Nothing [] type HostName = String type Domain = String -- cgit v1.3-2-g0d8e From 95ac5163da904780ae166c2bf3a0addcb8d8870e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 13 Apr 2014 15:34:01 -0400 Subject: Properties can now be satisfied differently on different operating systems. --- Propellor/Attr.hs | 7 +++++++ Propellor/Message.hs | 4 ++-- Propellor/Property.hs | 8 ++++++++ Propellor/Types.hs | 28 ++-------------------------- Propellor/Types/Attr.hs | 7 ++++++- Propellor/Types/OS.hs | 19 +++++++++++++++++++ config-joey.hs | 12 +++++++----- debian/changelog | 2 ++ propellor.cabal | 1 + 9 files changed, 54 insertions(+), 34 deletions(-) create mode 100644 Propellor/Types/OS.hs (limited to 'Propellor/Types') diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs index 67ea8b8c..9a9d8446 100644 --- a/Propellor/Attr.hs +++ b/Propellor/Attr.hs @@ -21,6 +21,13 @@ hostname name = pureAttrProperty ("hostname " ++ name) $ getHostName :: Propellor HostName getHostName = asks _hostname +os :: System -> AttrProperty +os system = pureAttrProperty ("OS " ++ show system) $ + \d -> d { _os = Just system } + +getOS :: Propellor (Maybe System) +getOS = asks _os + cname :: Domain -> AttrProperty cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain) diff --git a/Propellor/Message.hs b/Propellor/Message.hs index 2e63061e..780471c3 100644 --- a/Propellor/Message.hs +++ b/Propellor/Message.hs @@ -29,7 +29,7 @@ actionMessage desc a = do return r warningMessage :: MonadIO m => String -> m () -warningMessage s = liftIO $ colorLine Vivid Red $ "** warning: " ++ s +warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s colorLine :: ColorIntensity -> Color -> String -> IO () colorLine intensity color msg = do @@ -43,7 +43,7 @@ colorLine intensity color msg = do errorMessage :: String -> IO a errorMessage s = do - warningMessage s + liftIO $ colorLine Vivid Red $ "** error: " ++ s error "Cannot continue!" -- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1 diff --git a/Propellor/Property.hs b/Propellor/Property.hs index 3e41fbcb..95d17c05 100644 --- a/Propellor/Property.hs +++ b/Propellor/Property.hs @@ -10,6 +10,7 @@ import "mtl" Control.Monad.Reader import Propellor.Types import Propellor.Types.Attr +import Propellor.Attr import Propellor.Engine import Utility.Monad import System.FilePath @@ -91,6 +92,13 @@ check c property = Property (propertyDesc property) $ ifM (liftIO c) , return NoChange ) +-- | Makes a property that is satisfied differently depending on the host's +-- operating system. +-- +-- Note that the operating system may not be declared for some hosts. +withOS :: Desc -> (Maybe System -> Propellor Result) -> Property +withOS desc a = Property desc $ a =<< getOS + boolProperty :: Desc -> IO Bool -> Property boolProperty desc a = Property desc $ ifM (liftIO a) ( return MadeChange diff --git a/Propellor/Types.hs b/Propellor/Types.hs index b8f8f167..5f575daf 100644 --- a/Propellor/Types.hs +++ b/Propellor/Types.hs @@ -6,8 +6,6 @@ module Propellor.Types ( Host(..) , Attr , HostName - , UserName - , GroupName , Propellor(..) , Property(..) , RevertableProperty(..) @@ -19,16 +17,12 @@ module Propellor.Types , requires , Desc , Result(..) - , System(..) - , Distribution(..) - , DebianSuite(..) - , Release - , Architecture , ActionResult(..) , CmdLine(..) , PrivDataField(..) , GpgKeyId , SshKeyType(..) + , module Propellor.Types.OS ) where import Data.Monoid @@ -38,12 +32,10 @@ import "mtl" Control.Monad.Reader import "MonadCatchIO-transformers" Control.Monad.CatchIO import Propellor.Types.Attr +import Propellor.Types.OS data Host = Host [Property] (Attr -> Attr) -type UserName = String -type GroupName = String - -- | Propellor's monad provides read-only access to attributes of the -- system. newtype Propellor p = Propellor { runWithAttr :: ReaderT Attr IO p } @@ -119,22 +111,6 @@ instance Monoid Result where mappend _ MadeChange = MadeChange mappend NoChange NoChange = NoChange --- | High level descritption of a operating system. -data System = System Distribution Architecture - deriving (Show) - -data Distribution - = Debian DebianSuite - | Ubuntu Release - deriving (Show) - -data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release - deriving (Show, Eq) - -type Release = String - -type Architecture = String - -- | Results of actions, with color. class ActionResult a where getActionResult :: a -> (String, ColorIntensity, Color) diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs index cdbe9ca3..1ff58148 100644 --- a/Propellor/Types/Attr.hs +++ b/Propellor/Types/Attr.hs @@ -1,11 +1,14 @@ module Propellor.Types.Attr where +import Propellor.Types.OS + import qualified Data.Set as S -- | The attributes of a host. For example, its hostname. data Attr = Attr { _hostname :: HostName , _cnames :: S.Set Domain + , _os :: Maybe System , _sshPubKey :: Maybe String , _dockerImage :: Maybe String @@ -16,6 +19,7 @@ instance Eq Attr where x == y = and [ _hostname x == _hostname y , _cnames x == _cnames y + , _os x == _os y , _sshPubKey x == _sshPubKey y , _dockerImage x == _dockerImage y @@ -27,13 +31,14 @@ instance Show Attr where show a = unlines [ "hostname " ++ _hostname a , "cnames " ++ show (_cnames a) + , "OS " ++ show (_os a) , "sshPubKey " ++ show (_sshPubKey a) , "docker image " ++ show (_dockerImage a) , "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a)) ] newAttr :: HostName -> Attr -newAttr hn = Attr hn S.empty Nothing Nothing [] +newAttr hn = Attr hn S.empty Nothing Nothing Nothing [] type HostName = String type Domain = String diff --git a/Propellor/Types/OS.hs b/Propellor/Types/OS.hs new file mode 100644 index 00000000..5b0e376d --- /dev/null +++ b/Propellor/Types/OS.hs @@ -0,0 +1,19 @@ +module Propellor.Types.OS where + +type UserName = String +type GroupName = String + +-- | High level descritption of a operating system. +data System = System Distribution Architecture + deriving (Show, Eq) + +data Distribution + = Debian DebianSuite + | Ubuntu Release + deriving (Show, Eq) + +data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release + deriving (Show, Eq) + +type Release = String +type Architecture = String diff --git a/config-joey.hs b/config-joey.hs index aba648dc..ed214e82 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -29,7 +29,7 @@ hosts = & Apt.buildDep ["git-annex"] `period` Daily -- Nothing super-important lives here. - , standardSystem "clam.kitenet.net" Unstable + , standardSystem "clam.kitenet.net" Unstable "amd64" & cleanCloudAtCost & Apt.unattendedUpgrades & Network.ipv6to4 @@ -53,7 +53,7 @@ hosts = & Apt.installed ["git-annex", "mtr", "screen"] -- Orca is the main git-annex build box. - , standardSystem "orca.kitenet.net" Unstable + , standardSystem "orca.kitenet.net" Unstable "amd64" & Hostname.sane & Apt.unattendedUpgrades & Docker.configured @@ -65,7 +65,7 @@ hosts = & Apt.buildDep ["git-annex"] `period` Daily -- Important stuff that needs not too much memory or CPU. - , standardSystem "diatom.kitenet.net" Stable + , standardSystem "diatom.kitenet.net" Stable "amd64" & Hostname.sane & Ssh.hostKey SshDsa & Ssh.hostKey SshRsa @@ -142,8 +142,9 @@ gitAnnexBuilder arch buildminute = Docker.container (arch ++ "-git-annex-builder & Apt.unattendedUpgrades -- This is my standard system setup. -standardSystem :: HostName -> DebianSuite -> Host -standardSystem hn suite = host hn +standardSystem :: HostName -> DebianSuite -> Architecture -> Host +standardSystem hn suite arch = host hn + & os (System (Debian suite) arch) & Apt.stdSourcesList suite `onChange` Apt.upgrade & Apt.installed ["etckeeper"] & Apt.installed ["ssh"] @@ -166,6 +167,7 @@ standardSystem hn suite = host hn -- This is my standard container setup, featuring automatic upgrades. standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Host standardContainer name suite arch = Docker.container name (image system) + & os (System (Debian suite) arch) & Apt.stdSourcesList suite & Apt.unattendedUpgrades where diff --git a/debian/changelog b/debian/changelog index b3cc554a..4c18df20 100644 --- a/debian/changelog +++ b/debian/changelog @@ -4,6 +4,8 @@ propellor (0.3.1) UNRELEASED; urgency=medium * Support for provisioning hosts with ssh and gpg keys. * Obnam support. * Apache support. + * Properties can now be satisfied differently on different operating + systems. -- Joey Hess Fri, 11 Apr 2014 15:00:11 -0400 diff --git a/propellor.cabal b/propellor.cabal index a7b7fbca..1d625381 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -97,6 +97,7 @@ Library Propellor.Engine Propellor.Exception Propellor.Types + Propellor.Types.OS Other-Modules: Propellor.Types.Attr Propellor.CmdLine -- cgit v1.3-2-g0d8e From 90370dc57576ec6d4701acd4b5672eeba269a386 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 13 Apr 2014 17:50:44 -0400 Subject: stable-backports can't be used :( --- Propellor/Property/Apache.hs | 4 ++++ Propellor/Property/Apt.hs | 15 ++++++++------- Propellor/Types/OS.hs | 7 +++++++ config-joey.hs | 6 ++++++ 4 files changed, 25 insertions(+), 7 deletions(-) (limited to 'Propellor/Types') diff --git a/Propellor/Property/Apache.hs b/Propellor/Property/Apache.hs index 81daf9e7..eab87862 100644 --- a/Propellor/Property/Apache.hs +++ b/Propellor/Property/Apache.hs @@ -11,10 +11,12 @@ siteEnabled :: HostName -> ConfigFile -> RevertableProperty siteEnabled hn cf = RevertableProperty enable disable where enable = cmdProperty "a2ensite" ["--quiet", hn] + `describe` ("apache site enabled " ++ hn) `requires` siteAvailable hn cf `requires` installed `onChange` reloaded disable = File.notPresent (siteCfg hn) + `describe` ("apache site disabled " ++ hn) `onChange` cmdProperty "a2dissite" ["--quiet", hn] `requires` installed `onChange` reloaded @@ -29,9 +31,11 @@ modEnabled :: String -> RevertableProperty modEnabled modname = RevertableProperty enable disable where enable = cmdProperty "a2enmod" ["--quiet", modname] + `describe` ("apache module enabled " ++ modname) `requires` installed `onChange` reloaded disable = cmdProperty "a2dismod" ["--quiet", modname] + `describe` ("apache module disabled " ++ modname) `requires` installed `onChange` reloaded diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs index b7c281ce..5c095d64 100644 --- a/Propellor/Property/Apt.hs +++ b/Propellor/Property/Apt.hs @@ -24,8 +24,8 @@ showSuite Unstable = "unstable" showSuite Experimental = "experimental" showSuite (DebianRelease r) = r -backportSuite :: DebianSuite -> String -backportSuite suite = showSuite suite ++ "-backports" +backportSuite :: String +backportSuite = showSuite stableRelease ++ "-backports" debLine :: String -> Url -> [Section] -> Line debLine suite mirror sections = unwords $ @@ -41,11 +41,11 @@ stdSections = ["main", "contrib", "non-free"] binandsrc :: String -> DebianSuite -> [Line] binandsrc url suite - | suite == Stable = [l, srcLine l, bl, srcLine bl] + | isStable suite = [l, srcLine l, bl, srcLine bl] | otherwise = [l, srcLine l] where l = debLine (showSuite suite) url stdSections - bl = debLine (backportSuite suite) url stdSections + bl = debLine backportSuite url stdSections debCdn :: DebianSuite -> [Line] debCdn = binandsrc "http://cdn.debian.net/debian" @@ -56,7 +56,7 @@ kernelOrg = binandsrc "http://mirrors.kernel.org/debian" -- | Only available for Stable and Testing securityUpdates :: DebianSuite -> [Line] securityUpdates suite - | suite == Stable || suite == Testing = + | isStable suite || suite == Testing = let l = "deb http://security.debian.org/ " ++ showSuite suite ++ "/updates " ++ unwords stdSections in [l, srcLine l] | otherwise = [] @@ -104,9 +104,10 @@ installed' params ps = robustly $ check (isInstallable ps) go installedBackport :: [Package] -> Property installedBackport ps = withOS desc $ \o -> case o of - (Just (System (Debian suite) _)) -> - ensureProperty $ installed' ["-t", backportSuite suite, "-y"] ps Nothing -> error "cannot install backports; os not declared" + (Just (System (Debian suite) _)) + | isStable suite -> + ensureProperty $ installed' ["-t", backportSuite, "-y"] ps _ -> error $ "backports not supported on " ++ show o where desc = (unwords $ "apt installed backport":ps) diff --git a/Propellor/Types/OS.hs b/Propellor/Types/OS.hs index 5b0e376d..0635b271 100644 --- a/Propellor/Types/OS.hs +++ b/Propellor/Types/OS.hs @@ -15,5 +15,12 @@ data Distribution data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release deriving (Show, Eq) +-- | The release that currently corresponds to stable. +stableRelease :: DebianSuite +stableRelease = DebianRelease "wheezy" + +isStable :: DebianSuite -> Bool +isStable s = s == Stable || s == stableRelease + type Release = String type Architecture = String diff --git a/config-joey.hs b/config-joey.hs index 055c1a65..031b493f 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -86,6 +86,12 @@ hosts = "840760dc-08f0-11e2-8c61-576b7e66acfd" [("turtle", "ssh://turtle.kitenet.net/~/lib/downloads/")] & Apt.buildDep ["git-annex"] `period` Daily + -- rsync server for git-annex autobuilders + & Apt.installed ["rsync"] + & hasPrivContent "/etc/rsyncd.conf" + & hasPrivContent "/etc/rsyncd.secrets" + & "/etc/default/rsync" `File.containsLine` "" + `describe` "rsync server enabled" & cname "tmp.kitenet.net" & JoeySites.annexWebSite hosts "/srv/git/joey/tmp.git" -- cgit v1.3-2-g0d8e