diff --git a/CmdLine.hs b/Propellor/CmdLine.hs similarity index 98% rename from CmdLine.hs rename to Propellor/CmdLine.hs index c93d69a..b60b916 100644 --- a/CmdLine.hs +++ b/Propellor/CmdLine.hs @@ -1,10 +1,10 @@ -module CmdLine where +module Propellor.CmdLine where import System.Environment import Data.List import System.Exit -import Common +import Propellor.Common import Utility.FileMode data CmdLine diff --git a/Common.hs b/Propellor/Common.hs similarity index 71% rename from Common.hs rename to Propellor/Common.hs index 93704ce..3a08554 100644 --- a/Common.hs +++ b/Propellor/Common.hs @@ -1,9 +1,9 @@ -module Common (module X) where +module Propellor.Common (module X) where -import Types as X -import Property as X -import Property.Cmd as X -import PrivData as X +import Propellor.Types as X +import Propellor.Property as X +import Propellor.Property.Cmd as X +import Propellor.PrivData as X import Utility.PartialPrelude as X import Control.Applicative as X diff --git a/PrivData.hs b/Propellor/PrivData.hs similarity index 93% rename from PrivData.hs rename to Propellor/PrivData.hs index d1e75c8..cf4840b 100644 --- a/PrivData.hs +++ b/Propellor/PrivData.hs @@ -1,4 +1,4 @@ -module PrivData where +module Propellor.PrivData where import qualified Data.Map as M import Control.Applicative @@ -8,8 +8,8 @@ import System.Directory import Data.Maybe import Control.Monad -import Types -import Property +import Propellor.Types +import Propellor.Property import Utility.Monad import Utility.PartialPrelude import Utility.Exception @@ -18,7 +18,7 @@ import Utility.Tmp import Utility.SafeCommand import Utility.Misc -{- Note that removing or changing field names will break the +{- | Note that removing or changing field names will break the - serialized privdata files, so don't do that! - It's fine to add new fields. -} data PrivDataField diff --git a/Property.hs b/Propellor/Property.hs similarity index 86% rename from Property.hs rename to Propellor/Property.hs index c37af3d..727fe25 100644 --- a/Property.hs +++ b/Propellor/Property.hs @@ -1,4 +1,4 @@ -module Property where +module Propellor.Property where import System.Directory import Control.Monad @@ -6,7 +6,7 @@ import System.Console.ANSI import System.Exit import System.IO -import Types +import Propellor.Types import Utility.Monad import Utility.Exception @@ -16,7 +16,7 @@ makeChange a = a >> return MadeChange noChange :: IO Result noChange = return NoChange -{- Combines a list of properties, resulting in a single property +{- | 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. @@ -24,7 +24,7 @@ noChange = return NoChange propertyList :: Desc -> [Property] -> Property propertyList desc ps = Property desc $ ensureProperties' ps -{- Combines a list of properties, resulting in one property that +{- | Combines a list of properties, resulting in one property that - ensures each in turn, stopping on failure. -} combineProperties :: [Property] -> Property combineProperties ps = Property desc $ go ps NoChange @@ -39,7 +39,7 @@ combineProperties ps = Property desc $ go ps NoChange (p:_) -> propertyDesc p _ -> "(empty)" -{- Makes a perhaps non-idempotent Property be idempotent by using a flag +{- | Makes a perhaps non-idempotent Property be idempotent by using a flag - file to indicate whether it has run before. - Use with caution. -} flagFile :: Property -> FilePath -> Property @@ -53,7 +53,7 @@ flagFile property flagfile = Property (propertyDesc property) $ writeFile flagfile "" return r -{- Whenever a change has to be made for a Property, causes a hook +{- | Whenever a change has to be made for a Property, causes a hook - Property to also be run, but not otherwise. -} onChange :: Property -> Property -> Property property `onChange` hook = Property (propertyDesc property) $ do @@ -64,7 +64,7 @@ property `onChange` hook = Property (propertyDesc property) $ do return $ combineResult r r' _ -> return r -{- Indicates that the first property can only be satisfied once +{- | Indicates that the first property can only be satisfied once - the second is. -} requires :: Property -> Property -> Property x `requires` y = combineProperties [y, x] `describe` propertyDesc x @@ -76,7 +76,7 @@ describe p d = p { propertyDesc = d } (==>) = flip describe infixl 1 ==> -{- Makes a Property only be performed when a test succeeds. -} +{- | Makes a Property only be performed when a test succeeds. -} check :: IO Bool -> Property -> Property check c property = Property (propertyDesc property) $ ifM c ( ensureProperty property diff --git a/Property/Apt.hs b/Propellor/Property/Apt.hs similarity index 91% rename from Property/Apt.hs rename to Propellor/Property/Apt.hs index b89fb30..a7d5040 100644 --- a/Property/Apt.hs +++ b/Propellor/Property/Apt.hs @@ -1,4 +1,4 @@ -module Property.Apt where +module Propellor.Property.Apt where import Data.Maybe import Control.Applicative @@ -6,9 +6,9 @@ import Data.List import System.IO import Control.Monad -import Common -import qualified Property.File as File -import Property.File (Line) +import Propellor.Common +import qualified Propellor.Property.File as File +import Propellor.Property.File (Line) sourcesList :: FilePath sourcesList = "/etc/apt/sources.list" @@ -42,7 +42,7 @@ debCdn suite = [l, srcLine l] where l = debLine suite "http://cdn.debian.net/debian" stdSections -{- Makes sources.list have a standard content using the mirror CDN, +{- | Makes sources.list have a standard content using the mirror CDN, - with a particular Suite. -} stdSourcesList :: Suite -> Property stdSourcesList suite = setSourcesList (debCdn suite) @@ -89,7 +89,7 @@ isInstallable ps = do isInstalled :: Package -> IO Bool isInstalled p = (== [True]) <$> isInstalled' [p] -{- Note that the order of the returned list will not always +{- | Note that the order of the returned list will not always - correspond to the order of the input list. The number of items may - even vary. If apt does not know about a package at all, it will not - be included in the result list. -} @@ -117,7 +117,7 @@ unattendedUpgrades enabled = | enabled = "true" | otherwise = "false" -{- Preseeds debconf values and reconfigures the package so it takes +{- | Preseeds debconf values and reconfigures the package so it takes - effect. -} reConfigure :: Package -> [(String, String, String)] -> Property reConfigure package vals = reconfigure `requires` setselections diff --git a/Property/Cmd.hs b/Propellor/Property/Cmd.hs similarity index 93% rename from Property/Cmd.hs rename to Propellor/Property/Cmd.hs index 278d2fb..6e23955 100644 --- a/Property/Cmd.hs +++ b/Propellor/Property/Cmd.hs @@ -1,4 +1,4 @@ -module Property.Cmd ( +module Propellor.Property.Cmd ( cmdProperty, cmdProperty', scriptProperty, @@ -8,7 +8,7 @@ module Property.Cmd ( import Control.Applicative import Data.List -import Types +import Propellor.Types import Utility.Monad import Utility.SafeCommand import Utility.Env diff --git a/Property/Docker.hs b/Propellor/Property/Docker.hs similarity index 57% rename from Property/Docker.hs rename to Propellor/Property/Docker.hs index ebb3d3a..744feb4 100644 --- a/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -1,10 +1,10 @@ -module Property.Docker where +module Propellor.Property.Docker where -import Common -import qualified Property.File as File -import qualified Property.Apt as Apt +import Propellor.Common +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt -{- Configures docker with an authentication file, so that images can be +{- | Configures docker with an authentication file, so that images can be - pushed to index.docker.io. -} configured :: Property configured = Property "docker configured" go `requires` installed diff --git a/Property/File.hs b/Propellor/Property/File.hs similarity index 77% rename from Property/File.hs rename to Propellor/Property/File.hs index 55ca4fe..082542e 100644 --- a/Property/File.hs +++ b/Propellor/Property/File.hs @@ -1,15 +1,15 @@ -module Property.File where +module Propellor.Property.File where -import Common +import Propellor.Common type Line = String -{- Replaces all the content of a file. -} +{- | Replaces all the content of a file. -} hasContent :: FilePath -> [Line] -> Property 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. -} +{- | 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) go f where @@ -17,13 +17,13 @@ f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f | l `elem` ls = ls | otherwise = ls++[l] -{- Ensures that a line is not present in a file. +{- | Ensures that a line is not present in a file. - 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) (filter (/= l)) f -{- Note: Does not remove symlinks or non-plain-files. -} +{- | Removes a file. Does not remove symlinks or non-plain-files. -} notPresent :: FilePath -> Property notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $ makeChange $ nukeFile f diff --git a/Property/GitHome.hs b/Propellor/Property/GitHome.hs similarity index 81% rename from Property/GitHome.hs rename to Propellor/Property/GitHome.hs index 99402b8..400586e 100644 --- a/Property/GitHome.hs +++ b/Propellor/Property/GitHome.hs @@ -1,10 +1,10 @@ -module Property.GitHome where +module Propellor.Property.GitHome where -import Common -import qualified Property.Apt as Apt -import Property.User +import Propellor.Common +import qualified Propellor.Property.Apt as Apt +import Propellor.Property.User -{- Clones Joey Hess's git home directory, and runs its fixups script. -} +{- | Clones Joey Hess's git home directory, and runs its fixups script. -} installedFor :: UserName -> Property installedFor user = check (not <$> hasGitDir user) $ Property ("githome " ++ user) (go =<< homedir user) diff --git a/Property/Hostname.hs b/Propellor/Property/Hostname.hs similarity index 61% rename from Property/Hostname.hs rename to Propellor/Property/Hostname.hs index 204ff5d..8daf6bb 100644 --- a/Property/Hostname.hs +++ b/Propellor/Property/Hostname.hs @@ -1,7 +1,7 @@ -module Property.Hostname where +module Propellor.Property.Hostname where -import Common -import qualified Property.File as File +import Propellor.Common +import qualified Propellor.Property.File as File set :: HostName -> Property set hostname = "/etc/hostname" `File.hasContent` [hostname] diff --git a/Property/JoeySites.hs b/Propellor/Property/JoeySites.hs similarity index 79% rename from Property/JoeySites.hs rename to Propellor/Property/JoeySites.hs index 92279ae..e862916 100644 --- a/Property/JoeySites.hs +++ b/Propellor/Property/JoeySites.hs @@ -1,10 +1,10 @@ -{- Specific configuation for Joey Hess's sites. Probably not useful to - - others except as an example. -} +-- | Specific configuation for Joey Hess's sites. Probably not useful to +-- others except as an example. -module Property.JoeySites where +module Propellor.Property.JoeySites where -import Common -import qualified Property.Apt as Apt +import Propellor.Common +import qualified Propellor.Property.Apt as Apt oldUseNetshellBox :: Property oldUseNetshellBox = check (not <$> Apt.isInstalled "oldusenet") $ diff --git a/Property/Network.hs b/Propellor/Property/Network.hs similarity index 78% rename from Property/Network.hs rename to Propellor/Property/Network.hs index cd98100..704455b 100644 --- a/Property/Network.hs +++ b/Propellor/Property/Network.hs @@ -1,12 +1,12 @@ -module Property.Network where +module Propellor.Property.Network where -import Common -import Property.File +import Propellor.Common +import Propellor.Property.File interfaces :: FilePath interfaces = "/etc/network/interfaces" --- 6to4 ipv6 connection, should work anywhere +-- | 6to4 ipv6 connection, should work anywhere ipv6to4 :: Property ipv6to4 = fileProperty "ipv6to4" go interfaces `onChange` ifUp "sit0" diff --git a/Property/Reboot.hs b/Propellor/Property/Reboot.hs similarity index 53% rename from Property/Reboot.hs rename to Propellor/Property/Reboot.hs index 9b06f07..1a419d6 100644 --- a/Property/Reboot.hs +++ b/Propellor/Property/Reboot.hs @@ -1,6 +1,6 @@ -module Property.Reboot where +module Propellor.Property.Reboot where -import Common +import Propellor.Common now :: Property now = cmdProperty "reboot" [] diff --git a/Property/Ssh.hs b/Propellor/Property/Ssh.hs similarity index 87% rename from Property/Ssh.hs rename to Propellor/Property/Ssh.hs index c726bed..39e0268 100644 --- a/Property/Ssh.hs +++ b/Propellor/Property/Ssh.hs @@ -1,8 +1,8 @@ -module Property.Ssh where +module Propellor.Property.Ssh where -import Common -import qualified Property.File as File -import Property.User +import Propellor.Common +import qualified Propellor.Property.File as File +import Propellor.Property.User sshBool :: Bool -> String sshBool True = "yes" @@ -37,7 +37,7 @@ hasAuthorizedKeys = go <=< homedir restartSshd :: Property restartSshd = cmdProperty "service" [Param "ssh", Param "restart"] -{- Blow away existing host keys and make new ones. Use a flag +{- | Blow away existing host keys and make new ones. Use a flag - file to prevent doing this more than once. -} uniqueHostKeys :: Property uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" diff --git a/Property/Sudo.hs b/Propellor/Property/Sudo.hs similarity index 75% rename from Property/Sudo.hs rename to Propellor/Property/Sudo.hs index f341a3e..0548441 100644 --- a/Property/Sudo.hs +++ b/Propellor/Property/Sudo.hs @@ -1,13 +1,13 @@ -module Property.Sudo where +module Propellor.Property.Sudo where import Data.List -import Common -import Property.File -import qualified Property.Apt as Apt -import Property.User +import Propellor.Common +import Propellor.Property.File +import qualified Propellor.Property.Apt as Apt +import Propellor.Property.User -{- Allows a user to sudo. If the user has a password, sudo is configured +{- | Allows a user to sudo. If the user has a password, sudo is configured - to require it. If not, NOPASSWORD is enabled for the user. - - TOOD: Full sudoers file format parse.. diff --git a/Property/Tor.hs b/Propellor/Property/Tor.hs similarity index 69% rename from Property/Tor.hs rename to Propellor/Property/Tor.hs index f718212..aa5d29e 100644 --- a/Property/Tor.hs +++ b/Propellor/Property/Tor.hs @@ -1,8 +1,8 @@ -module Property.Tor where +module Propellor.Property.Tor where -import Common -import qualified Property.File as File -import qualified Property.Apt as Apt +import Propellor.Common +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt isBridge :: Property isBridge = setup `requires` Apt.installed ["tor"] diff --git a/Property/User.hs b/Propellor/Property/User.hs similarity index 90% rename from Property/User.hs rename to Propellor/Property/User.hs index 6bdff2e..2d2118c 100644 --- a/Property/User.hs +++ b/Propellor/Property/User.hs @@ -1,8 +1,8 @@ -module Property.User where +module Propellor.Property.User where import System.Posix -import Common +import Propellor.Common data Eep = YesReallyDeleteHome @@ -14,7 +14,7 @@ sshAccountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser" ] `describe` ("ssh account " ++ user) -{- Removes user home directory!! Use with caution. -} +{- | Removes user home directory!! Use with caution. -} nuked :: UserName -> Eep -> Property nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel" [ Param "-r" @@ -22,7 +22,7 @@ nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel" ] `describe` ("nuked user " ++ user) -{- Only ensures that the user has some password set. It may or may +{- | Only ensures that the user has some password set. It may or may - not be the password from the PrivData. -} hasSomePassword :: UserName -> Property hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $ diff --git a/Types.hs b/Propellor/Types.hs similarity index 86% rename from Types.hs rename to Propellor/Types.hs index d22bd17..70ad8f9 100644 --- a/Types.hs +++ b/Propellor/Types.hs @@ -1,11 +1,11 @@ -module Types where +module Propellor.Types where type HostName = String type UserName = String data Property = Property { propertyDesc :: Desc - -- must be idempotent; may run repeatedly + -- | must be idempotent; may run repeatedly , propertySatisfy :: IO Result } diff --git a/README b/README index 84c4b81..a85e34a 100644 --- a/README +++ b/README @@ -11,9 +11,9 @@ to a system, and "make" can be used to pull down any new changes, and compile and run propellor. This can be done by a cron job, or something can ssh in and run it. -Properties are defined using Haskell. Edit Propellor.hs +Properties are defined using Haskell. Edit propellor.hs to get started. -There is no special language as used in puppet, chef, ansible, etc, just +There is no special language as used in puppet, chef, ansible, etc.. just the full power of Haskell. Hopefully that power can be put to good use in making declarative properties that are powerful, nicely idempotent, and easy to adapt to a system's special needs. diff --git a/propellor.cabal b/propellor.cabal index eebb4f0..f78874b 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 0 +Version: 0.1 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess @@ -10,13 +10,21 @@ License-File: GPL Build-Type: Simple Homepage: http://joeyh.name/code/propellor/ Category: Utility +Extra-Source-Files: + README + TODO + Makefile Synopsis: property-based host configuration management in haskell Description: Propellor enures that the system it's run in satisfies a list of properties, taking action as necessary when a property is not yet met. + . + While Propellor can be installed from hackage, to customize and use it + you should fork its git repository and modify it from there: + git clone git://git.kitenet.net/propellor Executable propellor - Main-Is: Propellor.hs + Main-Is: propellor.hs GHC-Options: -Wall Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, @@ -25,6 +33,50 @@ Executable propellor if (! os(windows)) Build-Depends: unix +Library + GHC-Options: -Wall + Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, + IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, + containers + + if (! os(windows)) + Build-Depends: unix + + Exposed-Modules: + Propellor.Property + Propellor.Property.Apt + Propellor.Property.Cmd + Propellor.Property.Docker + Propellor.Property.File + Propellor.Property.GitHome + Propellor.Property.Hostname + Propellor.Property.JoeySites + Propellor.Property.Network + Propellor.Property.Reboot + Propellor.Property.Ssh + Propellor.Property.Sudo + Propellor.Property.Tor + Propellor.Property.User + Propellor.CmdLine + Propellor.Common + Propellor.PrivData + Propellor.Types + Other-Modules: + Utility.Applicative + Utility.Data + Utility.Directory + Utility.Env + Utility.Exception + Utility.FileMode + Utility.FileSystemEncoding + Utility.Misc + Utility.Monad + Utility.PartialPrelude + Utility.PosixFiles + Utility.Process + Utility.SafeCommand + Utility.Tmp + source-repository head type: git location: git://git.kitenet.net/propellor.git diff --git a/Propellor.hs b/propellor.hs similarity index 71% rename from Propellor.hs rename to propellor.hs index 58d8289..695fdf8 100644 --- a/Propellor.hs +++ b/propellor.hs @@ -1,24 +1,27 @@ -import Common -import CmdLine -import qualified Property.File as File -import qualified Property.Apt as Apt -import qualified Property.Network as Network -import qualified Property.Ssh as Ssh -import qualified Property.Sudo as Sudo -import qualified Property.User as User -import qualified Property.Hostname as Hostname -import qualified Property.Reboot as Reboot -import qualified Property.Tor as Tor -import qualified Property.Docker as Docker -import qualified Property.GitHome as GitHome -import qualified Property.JoeySites as JoeySites +import Propellor.Common +import Propellor.CmdLine +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Network as Network +import qualified Propellor.Property.Ssh as Ssh +import qualified Propellor.Property.Sudo as Sudo +import qualified Propellor.Property.User as User +import qualified Propellor.Property.Hostname as Hostname +import qualified Propellor.Property.Reboot as Reboot +import qualified Propellor.Property.Tor as Tor +import qualified Propellor.Property.Docker as Docker +import qualified Propellor.Property.GitHome as GitHome +import qualified Propellor.Property.JoeySites as JoeySites main :: IO () main = defaultMain getProperties -{- 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 - - Properties for that system. -} + - Properties for that system. + - + - Edit this to configure propellor! + -} getProperties :: HostName -> Maybe [Property] getProperties hostname@"clam.kitenet.net" = Just [ cleanCloudAtCost hostname