summaryrefslogtreecommitdiff
path: root/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-04-01 16:58:11 -0400
committerJoey Hess2014-04-01 16:58:11 -0400
commite6d24b49b87de312776bee71a2a6f009f7f397a9 (patch)
treeceba3045f23ee1d3cf36bfe8e8ffa9cb090b9e54 /Propellor/Property
parent6a82cdc41c89cc249da4d941a32920ebfd14cb92 (diff)
various improvements
Diffstat (limited to 'Propellor/Property')
-rw-r--r--Propellor/Property/Apt.hs20
-rw-r--r--Propellor/Property/Cmd.hs8
-rw-r--r--Propellor/Property/Docker.hs8
-rw-r--r--Propellor/Property/SiteSpecific/GitAnnexBuilder.hs45
-rw-r--r--Propellor/Property/SiteSpecific/GitHome.hs (renamed from Propellor/Property/GitHome.hs)21
-rw-r--r--Propellor/Property/SiteSpecific/JoeySites.hs (renamed from Propellor/Property/JoeySites.hs)2
-rw-r--r--Propellor/Property/User.hs10
7 files changed, 88 insertions, 26 deletions
diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs
index c91415e1..9f2365e0 100644
--- a/Propellor/Property/Apt.hs
+++ b/Propellor/Property/Apt.hs
@@ -16,16 +16,14 @@ sourcesList = "/etc/apt/sources.list"
type Url = String
type Section = String
-data Suite = Stable | Testing | Unstable | Experimental
- deriving Show
-
-showSuite :: Suite -> String
+showSuite :: DebianSuite -> String
showSuite Stable = "stable"
showSuite Testing = "testing"
showSuite Unstable = "unstable"
showSuite Experimental = "experimental"
+showSuite (DebianRelease r) = r
-debLine :: Suite -> Url -> [Section] -> Line
+debLine :: DebianSuite -> Url -> [Section] -> Line
debLine suite mirror sections = unwords $
["deb", mirror, showSuite suite] ++ sections
@@ -37,14 +35,14 @@ srcLine l = case words l of
stdSections :: [Section]
stdSections = ["main", "contrib", "non-free"]
-debCdn :: Suite -> [Line]
+debCdn :: DebianSuite -> [Line]
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,
- - with a particular Suite. -}
-stdSourcesList :: Suite -> Property
+ - with a particular DebianSuite. -}
+stdSourcesList :: DebianSuite -> Property
stdSourcesList suite = setSourcesList (debCdn suite)
`describe` ("standard sources.list for " ++ show suite)
@@ -81,6 +79,12 @@ removed ps = check (or <$> isInstalled' ps) go
where
go = runApt $ ["-y", "remove"] ++ ps
+buildDep :: [Package] -> Property
+buildDep ps = check (isInstallable ps) go
+ `describe` (unwords $ "apt build-dep":ps)
+ where
+ go = runApt $ ["-y", "build-dep"] ++ ps
+
isInstallable :: [Package] -> IO Bool
isInstallable ps = do
l <- isInstalled' ps
diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs
index b1c9435a..1f668daf 100644
--- a/Propellor/Property/Cmd.hs
+++ b/Propellor/Property/Cmd.hs
@@ -2,6 +2,7 @@ module Propellor.Property.Cmd (
cmdProperty,
cmdProperty',
scriptProperty,
+ userScriptProperty,
serviceRunning,
) where
@@ -39,6 +40,13 @@ scriptProperty script = cmdProperty "sh" ["-c", shellcmd]
where
shellcmd = intercalate " ; " ("set -e" : script)
+-- | A property that can satisfied by running a series of shell commands,
+-- as user (staring in their home directory).
+userScriptProperty :: UserName -> [String] -> Property
+userScriptProperty user script = cmdProperty "su" ["-c", shellcmd, user]
+ where
+ shellcmd = intercalate " ; " ("set -e" : "cd" : script)
+
-- | Ensures that a service is running.
--
-- Note that due to the general poor state of init scripts, the best
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index 577c837a..97253a7f 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -99,12 +99,12 @@ containerDesc cid p = p `describe` desc
-- | Ensures that a docker container is set up and running. The container
-- has its own Properties which are handled by running propellor
-- inside the container.
-hasContainer
- :: HostName
+docked
+ :: (HostName -> ContainerName -> Maybe (Container))
+ -> HostName
-> ContainerName
- -> (HostName -> ContainerName -> Maybe (Container))
-> Property
-hasContainer hn cn findcontainer =
+docked findcontainer hn cn =
case findcontainer hn cn of
Nothing -> containerDesc cid $ Property "" $ do
warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
new file mode 100644
index 00000000..6c0ece40
--- /dev/null
+++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -0,0 +1,45 @@
+module Propellor.Property.SiteSpecific.GitAnnexBuilder where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.User as User
+import Propellor.Property.Cron (CronTimes)
+
+type Arch = String
+
+builduser :: UserName
+builduser = "builder"
+
+builddir :: FilePath
+builddir = "gitbuilder"
+
+builder :: Arch -> CronTimes -> Property
+builder arch crontimes = combineProperties
+ [ Apt.buildDep ["git-annex"]
+ , Apt.installed ["git", "rsync", "liblockfile-simple-perl"]
+ , serviceRunning "cron" `requires` Apt.installed ["cron"]
+ , User.accountFor builduser
+ , check (not <$> hasbuilddir) $ userScriptProperty builduser
+ [ "cabal update"
+ , "git clone https://github.com/joeyh/gitbuilder/"
+ , "cd gitbuilder && git checkout " ++ arch
+ , "echo '"++crontimes++" cd gitbuilder/autobuild' | crontab -"
+ ]
+ `describe` "gitbuilder setup"
+ -- The builduser account does not have a password set,
+ -- instead use the password privdata to hold the rsync server
+ -- password used to upload the built image.
+ , Property "rsync password" $ do
+ d <- homedir
+ let f = d </> "rsyncpassword"
+ withPrivData (Password builduser) $ \p -> do
+ oldp <- catchDefaultIO "" $ readFileStrict f
+ if p /= oldp
+ then makeChange $ writeFile f p
+ else noChange
+ ]
+ where
+ homedir = fromMaybe ("/home/" ++ builduser) <$> User.homedir builduser
+ hasbuilddir = do
+ d <- homedir
+ doesDirectoryExist (d </> builddir)
diff --git a/Propellor/Property/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs
index 593aecd5..b3a8deff 100644
--- a/Propellor/Property/GitHome.hs
+++ b/Propellor/Property/SiteSpecific/GitHome.hs
@@ -1,11 +1,11 @@
-module Propellor.Property.GitHome where
+module Propellor.Property.SiteSpecific.GitHome where
import Propellor
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.User
import Utility.SafeCommand
-{- | 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)
@@ -14,15 +14,20 @@ installedFor user = check (not <$> hasGitDir user) $
go Nothing = noChange
go (Just home) = do
let tmpdir = home </> "githome"
- ok <- boolSystem "git" [Param "clone", Param url, Param tmpdir]
- <&&> (and <$> moveout tmpdir home)
- <&&> (catchBoolIO $ removeDirectory tmpdir >> return True)
- <&&> boolSystem "su" [Param "-c", Param "cd; rm -rf .aptitude/ .bashrc .profile; mr checkout; bin/fixups", Param user]
- return $ if ok then MadeChange else FailedChange
+ ensureProperty $ combineProperties
+ [ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
+ , Property "moveout" $ makeChange $ void $
+ moveout tmpdir home
+ , Property "rmdir" $ makeChange $ void $
+ catchMaybeIO $ removeDirectory tmpdir
+ , userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; mr checkout; bin/fixups"]
+ ]
moveout tmpdir home = do
fs <- dirContents tmpdir
forM fs $ \f -> boolSystem "mv" [File f, File home]
- url = "git://git.kitenet.net/joey/home"
+
+url :: String
+url = "git://git.kitenet.net/joey/home"
hasGitDir :: UserName -> IO Bool
hasGitDir user = go =<< homedir user
diff --git a/Propellor/Property/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index d92edb88..029064dd 100644
--- a/Propellor/Property/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -1,7 +1,7 @@
-- | Specific configuation for Joey Hess's sites. Probably not useful to
-- others except as an example.
-module Propellor.Property.JoeySites where
+module Propellor.Property.SiteSpecific.JoeySites where
import Propellor
import qualified Propellor.Property.Apt as Apt
diff --git a/Propellor/Property/User.hs b/Propellor/Property/User.hs
index 5a23f72d..951a173e 100644
--- a/Propellor/Property/User.hs
+++ b/Propellor/Property/User.hs
@@ -6,15 +6,15 @@ import Propellor
data Eep = YesReallyDeleteHome
-sshAccountFor :: UserName -> Property
-sshAccountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
+accountFor :: UserName -> Property
+accountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
[ "--disabled-password"
, "--gecos", ""
, user
]
`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"
[ "-r"
@@ -22,8 +22,8 @@ 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
- - not be the password from the PrivData. -}
+-- | 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) $
hasPassword user