prepare for hackage

This commit is contained in:
Joey Hess 2014-03-30 23:37:54 -04:00
parent 02a7bf5f0e
commit 380c1b0fd6
21 changed files with 154 additions and 99 deletions

View File

@ -1,10 +1,10 @@
module CmdLine where module Propellor.CmdLine where
import System.Environment import System.Environment
import Data.List import Data.List
import System.Exit import System.Exit
import Common import Propellor.Common
import Utility.FileMode import Utility.FileMode
data CmdLine data CmdLine

View File

@ -1,9 +1,9 @@
module Common (module X) where module Propellor.Common (module X) where
import Types as X import Propellor.Types as X
import Property as X import Propellor.Property as X
import Property.Cmd as X import Propellor.Property.Cmd as X
import PrivData as X import Propellor.PrivData as X
import Utility.PartialPrelude as X import Utility.PartialPrelude as X
import Control.Applicative as X import Control.Applicative as X

View File

@ -1,4 +1,4 @@
module PrivData where module Propellor.PrivData where
import qualified Data.Map as M import qualified Data.Map as M
import Control.Applicative import Control.Applicative
@ -8,8 +8,8 @@ import System.Directory
import Data.Maybe import Data.Maybe
import Control.Monad import Control.Monad
import Types import Propellor.Types
import Property import Propellor.Property
import Utility.Monad import Utility.Monad
import Utility.PartialPrelude import Utility.PartialPrelude
import Utility.Exception import Utility.Exception
@ -18,7 +18,7 @@ import Utility.Tmp
import Utility.SafeCommand import Utility.SafeCommand
import Utility.Misc 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! - serialized privdata files, so don't do that!
- It's fine to add new fields. -} - It's fine to add new fields. -}
data PrivDataField data PrivDataField

View File

@ -1,4 +1,4 @@
module Property where module Propellor.Property where
import System.Directory import System.Directory
import Control.Monad import Control.Monad
@ -6,7 +6,7 @@ import System.Console.ANSI
import System.Exit import System.Exit
import System.IO import System.IO
import Types import Propellor.Types
import Utility.Monad import Utility.Monad
import Utility.Exception import Utility.Exception
@ -16,7 +16,7 @@ makeChange a = a >> return MadeChange
noChange :: IO Result noChange :: IO Result
noChange = return NoChange 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, - 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 - and print out the description of each as it's run. Does not stop
- on failure; does propigate overall success/failure. - on failure; does propigate overall success/failure.
@ -24,7 +24,7 @@ noChange = return NoChange
propertyList :: Desc -> [Property] -> Property propertyList :: Desc -> [Property] -> Property
propertyList desc ps = Property desc $ ensureProperties' ps 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. -} - ensures each in turn, stopping on failure. -}
combineProperties :: [Property] -> Property combineProperties :: [Property] -> Property
combineProperties ps = Property desc $ go ps NoChange combineProperties ps = Property desc $ go ps NoChange
@ -39,7 +39,7 @@ combineProperties ps = Property desc $ go ps NoChange
(p:_) -> propertyDesc p (p:_) -> propertyDesc p
_ -> "(empty)" _ -> "(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. - file to indicate whether it has run before.
- Use with caution. -} - Use with caution. -}
flagFile :: Property -> FilePath -> Property flagFile :: Property -> FilePath -> Property
@ -53,7 +53,7 @@ flagFile property flagfile = Property (propertyDesc property) $
writeFile flagfile "" writeFile flagfile ""
return r 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. -} - Property to also be run, but not otherwise. -}
onChange :: Property -> Property -> Property onChange :: Property -> Property -> Property
property `onChange` hook = Property (propertyDesc property) $ do property `onChange` hook = Property (propertyDesc property) $ do
@ -64,7 +64,7 @@ property `onChange` hook = Property (propertyDesc property) $ do
return $ combineResult r r' return $ combineResult r r'
_ -> return 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. -} - the second is. -}
requires :: Property -> Property -> Property requires :: Property -> Property -> Property
x `requires` y = combineProperties [y, x] `describe` propertyDesc x x `requires` y = combineProperties [y, x] `describe` propertyDesc x
@ -76,7 +76,7 @@ describe p d = p { propertyDesc = d }
(==>) = flip describe (==>) = flip describe
infixl 1 ==> 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 :: IO Bool -> Property -> Property
check c property = Property (propertyDesc property) $ ifM c check c property = Property (propertyDesc property) $ ifM c
( ensureProperty property ( ensureProperty property

View File

@ -1,4 +1,4 @@
module Property.Apt where module Propellor.Property.Apt where
import Data.Maybe import Data.Maybe
import Control.Applicative import Control.Applicative
@ -6,9 +6,9 @@ import Data.List
import System.IO import System.IO
import Control.Monad import Control.Monad
import Common import Propellor.Common
import qualified Property.File as File import qualified Propellor.Property.File as File
import Property.File (Line) import Propellor.Property.File (Line)
sourcesList :: FilePath sourcesList :: FilePath
sourcesList = "/etc/apt/sources.list" sourcesList = "/etc/apt/sources.list"
@ -42,7 +42,7 @@ debCdn suite = [l, srcLine l]
where where
l = debLine suite "http://cdn.debian.net/debian" stdSections 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. -} - with a particular Suite. -}
stdSourcesList :: Suite -> Property stdSourcesList :: Suite -> Property
stdSourcesList suite = setSourcesList (debCdn suite) stdSourcesList suite = setSourcesList (debCdn suite)
@ -89,7 +89,7 @@ isInstallable ps = do
isInstalled :: Package -> IO Bool isInstalled :: Package -> IO Bool
isInstalled p = (== [True]) <$> isInstalled' [p] 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 - 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 - even vary. If apt does not know about a package at all, it will not
- be included in the result list. -} - be included in the result list. -}
@ -117,7 +117,7 @@ unattendedUpgrades enabled =
| enabled = "true" | enabled = "true"
| otherwise = "false" | otherwise = "false"
{- Preseeds debconf values and reconfigures the package so it takes {- | Preseeds debconf values and reconfigures the package so it takes
- effect. -} - effect. -}
reConfigure :: Package -> [(String, String, String)] -> Property reConfigure :: Package -> [(String, String, String)] -> Property
reConfigure package vals = reconfigure `requires` setselections reConfigure package vals = reconfigure `requires` setselections

View File

@ -1,4 +1,4 @@
module Property.Cmd ( module Propellor.Property.Cmd (
cmdProperty, cmdProperty,
cmdProperty', cmdProperty',
scriptProperty, scriptProperty,
@ -8,7 +8,7 @@ module Property.Cmd (
import Control.Applicative import Control.Applicative
import Data.List import Data.List
import Types import Propellor.Types
import Utility.Monad import Utility.Monad
import Utility.SafeCommand import Utility.SafeCommand
import Utility.Env import Utility.Env

View File

@ -1,10 +1,10 @@
module Property.Docker where module Propellor.Property.Docker where
import Common import Propellor.Common
import qualified Property.File as File import qualified Propellor.Property.File as File
import qualified Property.Apt as Apt 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. -} - pushed to index.docker.io. -}
configured :: Property configured :: Property
configured = Property "docker configured" go `requires` installed configured = Property "docker configured" go `requires` installed

View File

@ -1,15 +1,15 @@
module Property.File where module Propellor.Property.File where
import Common import Propellor.Common
type Line = String type Line = String
{- Replaces all the content of a file. -} {- | Replaces all the content of a file. -}
hasContent :: FilePath -> [Line] -> Property hasContent :: FilePath -> [Line] -> Property
f `hasContent` newcontent = fileProperty ("replace " ++ f) f `hasContent` newcontent = fileProperty ("replace " ++ f)
(\_oldcontent -> newcontent) 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 containsLine :: FilePath -> Line -> Property
f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f
where where
@ -17,13 +17,13 @@ f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f
| l `elem` ls = ls | l `elem` ls = ls
| otherwise = ls++[l] | 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 - Note that the file is ensured to exist, so if it doesn't, an empty
- file will be written. -} - file will be written. -}
lacksLine :: FilePath -> Line -> Property lacksLine :: FilePath -> Line -> Property
f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f 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 :: FilePath -> Property
notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $ notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $
makeChange $ nukeFile f makeChange $ nukeFile f

View File

@ -1,10 +1,10 @@
module Property.GitHome where module Propellor.Property.GitHome where
import Common import Propellor.Common
import qualified Property.Apt as Apt import qualified Propellor.Property.Apt as Apt
import Property.User 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 :: UserName -> Property
installedFor user = check (not <$> hasGitDir user) $ installedFor user = check (not <$> hasGitDir user) $
Property ("githome " ++ user) (go =<< homedir user) Property ("githome " ++ user) (go =<< homedir user)

View File

@ -1,7 +1,7 @@
module Property.Hostname where module Propellor.Property.Hostname where
import Common import Propellor.Common
import qualified Property.File as File import qualified Propellor.Property.File as File
set :: HostName -> Property set :: HostName -> Property
set hostname = "/etc/hostname" `File.hasContent` [hostname] set hostname = "/etc/hostname" `File.hasContent` [hostname]

View File

@ -1,10 +1,10 @@
{- Specific configuation for Joey Hess's sites. Probably not useful to -- | Specific configuation for Joey Hess's sites. Probably not useful to
- others except as an example. -} -- others except as an example.
module Property.JoeySites where module Propellor.Property.JoeySites where
import Common import Propellor.Common
import qualified Property.Apt as Apt import qualified Propellor.Property.Apt as Apt
oldUseNetshellBox :: Property oldUseNetshellBox :: Property
oldUseNetshellBox = check (not <$> Apt.isInstalled "oldusenet") $ oldUseNetshellBox = check (not <$> Apt.isInstalled "oldusenet") $

View File

@ -1,12 +1,12 @@
module Property.Network where module Propellor.Property.Network where
import Common import Propellor.Common
import Property.File import Propellor.Property.File
interfaces :: FilePath interfaces :: FilePath
interfaces = "/etc/network/interfaces" interfaces = "/etc/network/interfaces"
-- 6to4 ipv6 connection, should work anywhere -- | 6to4 ipv6 connection, should work anywhere
ipv6to4 :: Property ipv6to4 :: Property
ipv6to4 = fileProperty "ipv6to4" go interfaces ipv6to4 = fileProperty "ipv6to4" go interfaces
`onChange` ifUp "sit0" `onChange` ifUp "sit0"

View File

@ -1,6 +1,6 @@
module Property.Reboot where module Propellor.Property.Reboot where
import Common import Propellor.Common
now :: Property now :: Property
now = cmdProperty "reboot" [] now = cmdProperty "reboot" []

View File

@ -1,8 +1,8 @@
module Property.Ssh where module Propellor.Property.Ssh where
import Common import Propellor.Common
import qualified Property.File as File import qualified Propellor.Property.File as File
import Property.User import Propellor.Property.User
sshBool :: Bool -> String sshBool :: Bool -> String
sshBool True = "yes" sshBool True = "yes"
@ -37,7 +37,7 @@ hasAuthorizedKeys = go <=< homedir
restartSshd :: Property restartSshd :: Property
restartSshd = cmdProperty "service" [Param "ssh", Param "restart"] 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. -} - file to prevent doing this more than once. -}
uniqueHostKeys :: Property uniqueHostKeys :: Property
uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"

View File

@ -1,13 +1,13 @@
module Property.Sudo where module Propellor.Property.Sudo where
import Data.List import Data.List
import Common import Propellor.Common
import Property.File import Propellor.Property.File
import qualified Property.Apt as Apt import qualified Propellor.Property.Apt as Apt
import Property.User 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. - to require it. If not, NOPASSWORD is enabled for the user.
- -
- TOOD: Full sudoers file format parse.. - TOOD: Full sudoers file format parse..

View File

@ -1,8 +1,8 @@
module Property.Tor where module Propellor.Property.Tor where
import Common import Propellor.Common
import qualified Property.File as File import qualified Propellor.Property.File as File
import qualified Property.Apt as Apt import qualified Propellor.Property.Apt as Apt
isBridge :: Property isBridge :: Property
isBridge = setup `requires` Apt.installed ["tor"] isBridge = setup `requires` Apt.installed ["tor"]

View File

@ -1,8 +1,8 @@
module Property.User where module Propellor.Property.User where
import System.Posix import System.Posix
import Common import Propellor.Common
data Eep = YesReallyDeleteHome data Eep = YesReallyDeleteHome
@ -14,7 +14,7 @@ sshAccountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
] ]
`describe` ("ssh account " ++ user) `describe` ("ssh account " ++ user)
{- Removes user home directory!! Use with caution. -} {- | Removes user home directory!! Use with caution. -}
nuked :: UserName -> Eep -> Property nuked :: UserName -> Eep -> Property
nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel" nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel"
[ Param "-r" [ Param "-r"
@ -22,7 +22,7 @@ nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel"
] ]
`describe` ("nuked user " ++ user) `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. -} - not be the password from the PrivData. -}
hasSomePassword :: UserName -> Property hasSomePassword :: UserName -> Property
hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $ hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $

View File

@ -1,11 +1,11 @@
module Types where module Propellor.Types where
type HostName = String type HostName = String
type UserName = String type UserName = String
data Property = Property data Property = Property
{ propertyDesc :: Desc { propertyDesc :: Desc
-- must be idempotent; may run repeatedly -- | must be idempotent; may run repeatedly
, propertySatisfy :: IO Result , propertySatisfy :: IO Result
} }

4
README
View File

@ -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 and compile and run propellor. This can be done by a cron job, or
something can ssh in and run it. 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 the full power of Haskell. Hopefully that power can be put to good use in
making declarative properties that are powerful, nicely idempotent, and making declarative properties that are powerful, nicely idempotent, and
easy to adapt to a system's special needs. easy to adapt to a system's special needs.

View File

@ -1,5 +1,5 @@
Name: propellor Name: propellor
Version: 0 Version: 0.1
Cabal-Version: >= 1.6 Cabal-Version: >= 1.6
License: GPL License: GPL
Maintainer: Joey Hess <joey@kitenet.net> Maintainer: Joey Hess <joey@kitenet.net>
@ -10,13 +10,21 @@ License-File: GPL
Build-Type: Simple Build-Type: Simple
Homepage: http://joeyh.name/code/propellor/ Homepage: http://joeyh.name/code/propellor/
Category: Utility Category: Utility
Extra-Source-Files:
README
TODO
Makefile
Synopsis: property-based host configuration management in haskell Synopsis: property-based host configuration management in haskell
Description: Description:
Propellor enures that the system it's run in satisfies a list of 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. 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 Executable propellor
Main-Is: Propellor.hs Main-Is: propellor.hs
GHC-Options: -Wall GHC-Options: -Wall
Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
@ -25,6 +33,50 @@ Executable propellor
if (! os(windows)) if (! os(windows))
Build-Depends: unix 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 source-repository head
type: git type: git
location: git://git.kitenet.net/propellor.git location: git://git.kitenet.net/propellor.git

View File

@ -1,24 +1,27 @@
import Common import Propellor.Common
import CmdLine import Propellor.CmdLine
import qualified Property.File as File import qualified Propellor.Property.File as File
import qualified Property.Apt as Apt import qualified Propellor.Property.Apt as Apt
import qualified Property.Network as Network import qualified Propellor.Property.Network as Network
import qualified Property.Ssh as Ssh import qualified Propellor.Property.Ssh as Ssh
import qualified Property.Sudo as Sudo import qualified Propellor.Property.Sudo as Sudo
import qualified Property.User as User import qualified Propellor.Property.User as User
import qualified Property.Hostname as Hostname import qualified Propellor.Property.Hostname as Hostname
import qualified Property.Reboot as Reboot import qualified Propellor.Property.Reboot as Reboot
import qualified Property.Tor as Tor import qualified Propellor.Property.Tor as Tor
import qualified Property.Docker as Docker import qualified Propellor.Property.Docker as Docker
import qualified Property.GitHome as GitHome import qualified Propellor.Property.GitHome as GitHome
import qualified Property.JoeySites as JoeySites import qualified Propellor.Property.JoeySites as JoeySites
main :: IO () main :: IO ()
main = defaultMain getProperties 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 - 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 -> Maybe [Property]
getProperties hostname@"clam.kitenet.net" = Just getProperties hostname@"clam.kitenet.net" = Just
[ cleanCloudAtCost hostname [ cleanCloudAtCost hostname