summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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
-rw-r--r--Propellor/Types.hs18
-rw-r--r--config.hs32
9 files changed, 129 insertions, 35 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
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index df139dd6..4d8af2c9 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -26,6 +26,24 @@ 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)
+
+type Release = String
+
+data Architecture = Amd64 | I386 | Armel
+ deriving (Show)
+
+-- | Results of actions, with color.
class ActionResult a where
getActionResult :: a -> (String, ColorIntensity, Color)
diff --git a/config.hs b/config.hs
index bbd45b4e..b75ef8a5 100644
--- a/config.hs
+++ b/config.hs
@@ -14,8 +14,9 @@ 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
+import qualified Propellor.Property.SiteSpecific.GitHome as GitHome
+import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder
+import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites
main :: IO ()
main = defaultMain [host, Docker.containerProperties container]
@@ -28,7 +29,7 @@ main = defaultMain [host, Docker.containerProperties container]
host :: HostName -> Maybe [Property]
host hostname@"clam.kitenet.net" = Just
[ cleanCloudAtCost hostname
- , standardSystem Apt.Unstable
+ , standardSystem Unstable
, Apt.unattendedUpgrades True
, Network.ipv6to4
-- Clam is a tor bridge, and an olduse.net shellbox and other
@@ -37,15 +38,16 @@ host hostname@"clam.kitenet.net" = Just
, JoeySites.oldUseNetshellBox
, Docker.configured
, File.dirExists "/var/www"
- , Docker.hasContainer hostname "webserver" container
+ , Docker.docked container hostname "webserver"
, Apt.installed ["git-annex", "mtr"]
-- Should come last as it reboots.
, Apt.installed ["systemd-sysv"] `onChange` Reboot.now
]
-host "orca.kitenet.net" = Just
- [ standardSystem Apt.Unstable
+host hostname@"orca.kitenet.net" = Just
+ [ standardSystem Unstable
, Apt.unattendedUpgrades True
, Docker.configured
+ , Docker.docked container hostname "git-annex-amd64-builder"
]
-- add more hosts here...
--host "foo.example.com" =
@@ -54,7 +56,8 @@ host _ = Nothing
-- | This is where Docker containers are set up. A container
-- can vary by hostname where it's used, or be the same everywhere.
container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container)
-container _ "webserver" = Just $ Docker.containerFrom "joeyh/debian-unstable"
+container _ "webserver" = Just $ Docker.containerFrom
+ (image $ System (Debian Unstable) Amd64)
[ Docker.publish "8080:80"
, Docker.volume "/var/www:/var/www"
, Docker.inside
@@ -62,10 +65,21 @@ container _ "webserver" = Just $ Docker.containerFrom "joeyh/debian-unstable"
`requires` Apt.installed ["apache2"]
]
]
+container _ "git-annex-amd64-builder" = Just $ Docker.containerFrom
+ (image $ System (Debian Unstable) Amd64)
+ [ Docker.inside [ GitAnnexBuilder.builder "amd64" "30 * * * *" ] ]
container _ _ = Nothing
+-- | Docker images I prefer to use.
+-- Edit as suites you, or delete this function and just put the image names
+-- above.
+image :: System -> Docker.Image
+image (System (Debian Unstable) Amd64) = "joeyh/debian-unstable"
+image (System (Debian Unstable) I386) = "joeyh/debian-i386"
+image _ = "debian"
+
-- This is my standard system setup
-standardSystem :: Apt.Suite -> Property
+standardSystem :: DebianSuite -> Property
standardSystem suite = propertyList "standard system"
[ Apt.stdSourcesList suite `onChange` Apt.upgrade
, Apt.installed ["etckeeper"]
@@ -76,7 +90,7 @@ standardSystem suite = propertyList "standard system"
-- is safely in place.
, check (Ssh.hasAuthorizedKeys "root") $
Ssh.passwordAuthentication False
- , User.sshAccountFor "joey"
+ , User.accountFor "joey"
, User.hasSomePassword "joey"
, Sudo.enabledFor "joey"
, GitHome.installedFor "joey"