summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/Config/Joey.hs126
-rw-r--r--Propellor/Config/Simple.hs52
-rw-r--r--Propellor/Message.hs18
-rw-r--r--Propellor/Property/Docker.hs38
-rw-r--r--Propellor/Property/Docker/Shim.hs58
-rw-r--r--Propellor/Property/File.hs12
-rw-r--r--Propellor/Property/Hostname.hs28
7 files changed, 303 insertions, 29 deletions
diff --git a/Propellor/Config/Joey.hs b/Propellor/Config/Joey.hs
new file mode 100644
index 00000000..530df9a3
--- /dev/null
+++ b/Propellor/Config/Joey.hs
@@ -0,0 +1,126 @@
+-- | This is the live config file used by propellor's author.
+
+import Propellor
+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.Cron as Cron
+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.SiteSpecific.GitHome as GitHome
+import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder
+import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites
+import Data.List
+-- Only imported to make sure it continues to build.
+import qualified ConfigSimple as Simple
+
+main :: IO ()
+main = defaultMain [host, Docker.containerProperties container]
+
+-- | 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.
+--
+-- Edit this to configure propellor!
+host :: HostName -> Maybe [Property]
+-- Clam is a tor bridge, and an olduse.net shellbox and other fun stuff.
+host hostname@"clam.kitenet.net" = standardSystem Unstable $ props
+ & cleanCloudAtCost hostname
+ & Apt.unattendedUpgrades
+ & Network.ipv6to4
+ & Apt.installed ["git-annex", "mtr"]
+ & Tor.isBridge
+ & JoeySites.oldUseNetshellBox
+ & Docker.configured
+ ! Docker.docked container hostname "amd64-git-annex-builder"
+ & Docker.garbageCollected
+-- Orca is the main git-annex build box.
+host hostname@"orca.kitenet.net" = standardSystem Unstable $ props
+ & Hostname.set hostname
+ & Apt.unattendedUpgrades
+ & Docker.configured
+ & Apt.buildDep ["git-annex"]
+ & Docker.docked container hostname "amd64-git-annex-builder"
+ & Docker.docked container hostname "i386-git-annex-builder"
+ & Docker.garbageCollected
+-- My laptop
+host _hostname@"darkstar.kitenet.net" = Just $ props
+ & Docker.configured
+
+-- add more hosts here...
+--host "foo.example.com" =
+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 _host name
+ | name == "webserver" = Just $ Docker.containerFrom
+ (image $ System (Debian Unstable) "amd64")
+ [ Docker.publish "8080:80"
+ , Docker.volume "/var/www:/var/www"
+ , Docker.inside $ props
+ & serviceRunning "apache2"
+ `requires` Apt.installed ["apache2"]
+ ]
+ | "-git-annex-builder" `isSuffixOf` name =
+ let arch = takeWhile (/= '-') name
+ in Just $ Docker.containerFrom
+ (image $ System (Debian Unstable) arch)
+ [ Docker.inside $ props & GitAnnexBuilder.builder arch "15 * * * *" True ]
+ | otherwise = Nothing
+
+-- | Docker images I prefer to use.
+image :: System -> Docker.Image
+image (System (Debian Unstable) arch) = "joeyh/debian-unstable-" ++ arch
+image _ = "debian-stable-official" -- does not currently exist!
+
+-- This is my standard system setup
+standardSystem :: DebianSuite -> [Property] -> Maybe [Property]
+standardSystem suite customprops = Just $
+ standardprops : customprops ++ endprops
+ where
+ standardprops = propertyList "standard system" $ props
+ & Apt.stdSourcesList suite `onChange` Apt.upgrade
+ & Apt.installed ["etckeeper"]
+ & Apt.installed ["ssh"]
+ & GitHome.installedFor "root"
+ & User.hasSomePassword "root"
+ -- Harden the system, but only once root's authorized_keys
+ -- is safely in place.
+ & check (Ssh.hasAuthorizedKeys "root")
+ (Ssh.passwordAuthentication False)
+ & User.accountFor "joey"
+ & User.hasSomePassword "joey"
+ & Sudo.enabledFor "joey"
+ & GitHome.installedFor "joey"
+ & Apt.installed ["vim", "screen", "less"]
+ & Cron.runPropellor "30 * * * *"
+ -- I use postfix, or no MTA.
+ & Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]
+ `onChange` Apt.autoRemove
+ -- May reboot, so comes last
+ -- Currently not enable due to #726375
+ endprops = [] -- [Apt.installed ["systemd-sysv"] `onChange` Reboot.now]
+
+-- Clean up a system as installed by cloudatcost.com
+cleanCloudAtCost :: HostName -> Property
+cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"
+ [ Hostname.set hostname
+ , Ssh.uniqueHostKeys
+ , "worked around grub/lvm boot bug #743126" ==>
+ "/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
+ `onChange` cmdProperty "update-grub" []
+ `onChange` cmdProperty "update-initramfs" ["-u"]
+ , combineProperties "nuked cloudatcost cruft"
+ [ File.notPresent "/etc/rc.local"
+ , File.notPresent "/etc/init.d/S97-setup.sh"
+ , User.nuked "user" User.YesReallyDeleteHome
+ ]
+ ]
diff --git a/Propellor/Config/Simple.hs b/Propellor/Config/Simple.hs
new file mode 100644
index 00000000..840bad02
--- /dev/null
+++ b/Propellor/Config/Simple.hs
@@ -0,0 +1,52 @@
+-- | This is the main configuration file for Propellor, and is used to build
+-- the propellor program.
+
+import Propellor
+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.Cron as Cron
+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.Docker as Docker
+
+main :: IO ()
+main = defaultMain [host, Docker.containerProperties container]
+
+-- | 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.
+--
+-- Edit this to configure propellor!
+host :: HostName -> Maybe [Property]
+host hostname@"mybox.example.com" = Just $ props
+ & Apt.stdSourcesList Unstable
+ `onChange` Apt.upgrade
+ & Apt.unattendedUpgrades
+ & Apt.installed ["etckeeper"]
+ & Apt.installed ["ssh"]
+ & User.hasSomePassword "root"
+ & Network.ipv6to4
+ & File.dirExists "/var/www"
+ & Docker.docked container hostname "webserver"
+ & Docker.garbageCollected
+ & Cron.runPropellor "30 * * * *"
+-- add more hosts here...
+--host "foo.example.com" =
+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"
+ [ Docker.publish "80:80"
+ , Docker.volume "/var/www:/var/www"
+ , Docker.inside $ props
+ & serviceRunning "apache2"
+ `requires` Apt.installed ["apache2"]
+ ]
+container _ _ = Nothing
diff --git a/Propellor/Message.hs b/Propellor/Message.hs
index eb3f3177..5a7d8c4b 100644
--- a/Propellor/Message.hs
+++ b/Propellor/Message.hs
@@ -15,21 +15,25 @@ actionMessage desc a = do
r <- a
+ setTitle "propellor: running"
let (msg, intensity, color) = getActionResult r
putStr $ desc ++ " ... "
- setSGR [SetColor Foreground intensity color]
- putStrLn msg
- setSGR []
- setTitle "propellor: running"
+ colorLine intensity color msg
hFlush stdout
return r
warningMessage :: String -> IO ()
-warningMessage s = do
- setSGR [SetColor Foreground Vivid Red]
- putStrLn $ "** warning: " ++ s
+warningMessage s = colorLine Vivid Red $ "** warning: " ++ s
+
+colorLine :: ColorIntensity -> Color -> String -> IO ()
+colorLine intensity color msg = do
+ setSGR [SetColor Foreground intensity color]
+ putStr msg
setSGR []
+ -- Note this comes after the color is reset, so that
+ -- the color set and reset happen in the same line.
+ putStrLn ""
hFlush stdout
errorMessage :: String -> IO a
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index 5f819f26..888e76c6 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -4,13 +4,6 @@
--
-- The existance of a docker container is just another Property of a system,
-- which propellor can set up. See config.hs for an example.
---
--- Note that propellor provisions a container by running itself, inside the
--- container. Currently, to avoid the overhead of building propellor
--- inside the container, the binary from outside is reused inside.
--- So, the libraries that propellor is linked against need to be available
--- in the container with compatable versions. This can cause a problem
--- if eg, mixing Debian stable and unstable.
module Propellor.Property.Docker where
@@ -18,6 +11,7 @@ import Propellor
import Propellor.SimpleSh
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Docker.Shim as Shim
import Utility.SafeCommand
import Utility.Path
@@ -256,15 +250,14 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
, name (fromContainerId cid)
]
- chaincmd = [localdir </> "propellor", "--docker", fromContainerId cid]
-
go img = do
clearProvisionedFlag cid
createDirectoryIfMissing True (takeDirectory $ identFile cid)
+ shim <- Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
writeFile (identFile cid) (show ident)
ensureProperty $ boolProperty "run" $ runContainer img
(runps ++ ["-i", "-d", "-t"])
- chaincmd
+ [shim, "--docker", fromContainerId cid]
-- | Called when propellor is running inside a docker container.
-- The string should be the container's ContainerId.
@@ -290,8 +283,9 @@ chain s = case toContainerId s of
writeFile propellorIdent . show =<< readIdentFile cid
-- Run boot provisioning before starting simpleSh,
-- to avoid ever provisioning twice at the same time.
- whenM (checkProvisionedFlag cid) $
- unlessM (boolSystem "./propellor" [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $
+ whenM (checkProvisionedFlag cid) $ do
+ let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
+ unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $
warningMessage "Boot provision failed!"
void $ async $ simpleSh $ namedPipe cid
forever $ do
@@ -310,7 +304,8 @@ chain s = case toContainerId s of
-- 1 minute.
provisionContainer :: ContainerId -> Property
provisionContainer cid = containerDesc cid $ Property "provision" $ do
- r <- simpleShClientRetry 60 (namedPipe cid) "./propellor" params (go Nothing)
+ let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
+ r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
when (r /= FailedChange) $
setProvisionedFlag cid
return r
@@ -342,11 +337,17 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId
stoppedContainer :: ContainerId -> Property
stoppedContainer cid = containerDesc cid $ Property desc $
ifM (elem cid <$> listContainers RunningContainers)
- ( ensureProperty $ boolProperty desc $ stopContainer cid
+ ( cleanup `after` ensureProperty
+ (boolProperty desc $ stopContainer cid)
, return NoChange
)
where
desc = "stopped"
+ cleanup = do
+ nukeFile $ namedPipe cid
+ nukeFile $ identFile cid
+ removeDirectoryRecursive $ shimdir cid
+ clearProvisionedFlag cid
removeContainer :: ContainerId -> IO Bool
removeContainer cid = catchBoolIO $
@@ -396,10 +397,10 @@ propellorIdent = "/.propellor-ident"
-- | Named pipe used for communication with the container.
namedPipe :: ContainerId -> FilePath
-namedPipe cid = "docker/" ++ fromContainerId cid
+namedPipe cid = "docker" </> fromContainerId cid
provisionedFlag :: ContainerId -> FilePath
-provisionedFlag cid = "docker/" ++ fromContainerId cid ++ ".provisioned"
+provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"
clearProvisionedFlag :: ContainerId -> IO ()
clearProvisionedFlag = nukeFile . provisionedFlag
@@ -412,8 +413,11 @@ setProvisionedFlag cid = do
checkProvisionedFlag :: ContainerId -> IO Bool
checkProvisionedFlag = doesFileExist . provisionedFlag
+shimdir :: ContainerId -> FilePath
+shimdir cid = "docker" </> fromContainerId cid ++ ".shim"
+
identFile :: ContainerId -> FilePath
-identFile cid = "docker/" ++ fromContainerId cid ++ ".ident"
+identFile cid = "docker" </> fromContainerId cid ++ ".ident"
readIdentFile :: ContainerId -> IO ContainerIdent
readIdentFile cid = fromMaybe (error "bad ident in identFile")
diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs
new file mode 100644
index 00000000..01c2b22f
--- /dev/null
+++ b/Propellor/Property/Docker/Shim.hs
@@ -0,0 +1,58 @@
+-- | Support for running propellor, as built outside a docker container,
+-- inside the container.
+--
+-- Note: This is currently Debian specific, due to glibcLibs.
+
+module Propellor.Property.Docker.Shim (setup, file) where
+
+import Propellor
+import Utility.LinuxMkLibs
+import Utility.SafeCommand
+import Utility.Path
+import Utility.FileMode
+
+import Data.List
+import System.Posix.Files
+
+-- | Sets up a shimmed version of the program, in a directory, and
+-- returns its path.
+setup :: FilePath -> FilePath -> IO FilePath
+setup propellorbin dest = do
+ createDirectoryIfMissing True dest
+
+ libs <- parseLdd <$> readProcess "ldd" [propellorbin]
+ glibclibs <- glibcLibs
+ let libs' = nub $ libs ++ glibclibs
+ libdirs <- map (dest ++) . nub . catMaybes
+ <$> mapM (installLib installFile dest) libs'
+
+ let linker = (dest ++) $
+ fromMaybe (error "cannot find ld-linux linker") $
+ headMaybe $ filter ("ld-linux" `isInfixOf`) libs'
+ let gconvdir = (dest ++) $ parentDir $
+ fromMaybe (error "cannot find gconv directory") $
+ headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs
+ let linkerparams = ["--library-path", intercalate ":" libdirs ]
+ let shim = file propellorbin dest
+ writeFile shim $ unlines
+ [ "#!/bin/sh"
+ , "GCONV_PATH=" ++ shellEscape gconvdir
+ , "export GCONV_PATH"
+ , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++
+ " " ++ shellEscape propellorbin ++ " \"$@\""
+ ]
+ modifyFileMode shim (addModes executeModes)
+ return shim
+
+file :: FilePath -> FilePath -> FilePath
+file propellorbin dest = dest </> takeFileName propellorbin
+
+installFile :: FilePath -> FilePath -> IO ()
+installFile top f = do
+ createDirectoryIfMissing True destdir
+ nukeFile dest
+ createLink f dest `catchIO` (const copy)
+ where
+ copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
+ destdir = inTop top $ parentDir f
+ dest = inTop top f
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
index af4f554f..80c69d9b 100644
--- a/Propellor/Property/File.hs
+++ b/Propellor/Property/File.hs
@@ -2,6 +2,8 @@ module Propellor.Property.File where
import Propellor
+import System.Posix.Files
+
type Line = String
-- | Replaces all the content of a file.
@@ -32,13 +34,19 @@ fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
fileProperty desc a f = Property desc $ go =<< doesFileExist f
where
go True = do
- ls <- lines <$> catchDefaultIO [] (readFile f)
+ ls <- lines <$> readFile f
let ls' = a ls
if ls' == ls
then noChange
- else makeChange $ viaTmp writeFile f (unlines ls')
+ else makeChange $ viaTmp updatefile f (unlines ls')
go False = makeChange $ writeFile f (unlines $ a [])
+ -- viaTmp makes the temp file mode 600.
+ -- Replicate the original file mode before moving it into place.
+ updatefile f' content = do
+ writeFile f' content
+ getFileStatus f >>= setFileMode f' . fileMode
+
-- | Ensures a directory exists.
dirExists :: FilePath -> Property
dirExists d = check (not <$> doesDirectoryExist d) $ Property (d ++ " exists") $
diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs
index 25f0e1b2..26635374 100644
--- a/Propellor/Property/Hostname.hs
+++ b/Propellor/Property/Hostname.hs
@@ -3,7 +3,29 @@ module Propellor.Property.Hostname where
import Propellor
import qualified Propellor.Property.File as File
+-- | Sets the hostname. Configures both /etc/hostname and the current
+-- hostname.
+--
+-- When provided with a FQDN, also configures /etc/hosts,
+-- with an entry for 127.0.1.1, which is standard at least on Debian
+-- to set the FDQN (127.0.0.1 is localhost).
set :: HostName -> Property
-set hostname = "/etc/hostname" `File.hasContent` [hostname]
- `onChange` cmdProperty "hostname" [hostname]
- `describe` ("hostname " ++ hostname)
+set hostname = combineProperties desc go
+ `onChange` cmdProperty "hostname" [host]
+ where
+ desc = "hostname " ++ hostname
+ (host, domain) = separate (== '.') hostname
+
+ go = catMaybes
+ [ Just $ "/etc/hostname" `File.hasContent` [host]
+ , if null domain
+ then Nothing
+ else Just $ File.fileProperty desc
+ addhostline "/etc/hosts"
+ ]
+
+ hostip = "127.0.1.1"
+ hostline = hostip ++ "\t" ++ hostname ++ " " ++ host
+
+ addhostline ls = hostline : filter (not . hashostip) ls
+ hashostip l = headMaybe (words l) == Just hostip