summaryrefslogtreecommitdiff
path: root/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-04-11 01:09:01 -0400
committerJoey Hess2014-04-11 01:09:01 -0400
commit856ce97995bc34e35fd8e0233341f26a37b19cf5 (patch)
tree1d93492b36cd07d58437d2cb0f902ad53b3abe6e /Propellor/Property
parent07a071ac7f5b2f71e376a9a1a78a84a6bf02129b (diff)
parent47ff089f844c707eaa3ffd7255dc733721fb6adf (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'Propellor/Property')
-rw-r--r--Propellor/Property/Apt.hs30
-rw-r--r--Propellor/Property/Cmd.hs19
-rw-r--r--Propellor/Property/Cron.hs3
-rw-r--r--Propellor/Property/Dns.hs63
-rw-r--r--Propellor/Property/Docker.hs228
-rw-r--r--Propellor/Property/File.hs21
-rw-r--r--Propellor/Property/Git.hs48
-rw-r--r--Propellor/Property/Hostname.hs23
-rw-r--r--Propellor/Property/Network.hs1
-rw-r--r--Propellor/Property/OpenId.hs26
-rw-r--r--Propellor/Property/Scheduled.hs67
-rw-r--r--Propellor/Property/Service.hs31
-rw-r--r--Propellor/Property/SiteSpecific/GitAnnexBuilder.hs7
-rw-r--r--Propellor/Property/SiteSpecific/GitHome.hs6
-rw-r--r--Propellor/Property/SiteSpecific/JoeySites.hs4
-rw-r--r--Propellor/Property/Ssh.hs2
-rw-r--r--Propellor/Property/Sudo.hs2
17 files changed, 416 insertions, 165 deletions
diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs
index 8bbb1b19..4da13a2f 100644
--- a/Propellor/Property/Apt.hs
+++ b/Propellor/Property/Apt.hs
@@ -8,6 +8,7 @@ import Control.Monad
import Propellor
import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Service as Service
import Propellor.Property.File (Line)
sourcesList :: FilePath
@@ -46,13 +47,22 @@ debCdn = binandsrc "http://cdn.debian.net/debian"
kernelOrg :: DebianSuite -> [Line]
kernelOrg = binandsrc "http://mirrors.kernel.org/debian"
+-- | Only available for Stable and Testing
+securityUpdates :: DebianSuite -> [Line]
+securityUpdates suite
+ | suite == Stable || suite == Testing =
+ let l = "deb http://security.debian.org/ " ++ showSuite suite ++ "/updates " ++ unwords stdSections
+ in [l, srcLine l]
+ | otherwise = []
+
-- | Makes sources.list have a standard content using the mirror CDN,
-- with a particular DebianSuite.
--
-- Since the CDN is sometimes unreliable, also adds backup lines using
-- kernel.org.
stdSourcesList :: DebianSuite -> Property
-stdSourcesList suite = setSourcesList (debCdn suite ++ kernelOrg suite)
+stdSourcesList suite = setSourcesList
+ (debCdn suite ++ kernelOrg suite ++ securityUpdates suite)
`describe` ("standard sources.list for " ++ show suite)
setSourcesList :: [Line] -> Property
@@ -147,9 +157,12 @@ autoRemove = runApt ["-y", "autoremove"]
-- | Enables unattended upgrades. Revert to disable.
unattendedUpgrades :: RevertableProperty
-unattendedUpgrades = RevertableProperty (go True) (go False)
+unattendedUpgrades = RevertableProperty enable disable
where
- go enabled = (if enabled then installed else removed) ["unattended-upgrades"]
+ enable = setup True `before` Service.running "cron"
+ disable = setup False
+
+ setup enabled = (if enabled then installed else removed) ["unattended-upgrades"]
`onChange` reConfigure "unattended-upgrades"
[("unattended-upgrades/enable_auto_updates" , "boolean", v)]
`describe` ("unattended upgrades " ++ v)
@@ -167,7 +180,14 @@ reConfigure package vals = reconfigure `requires` setselections
setselections = Property "preseed" $ makeChange $
withHandle StdinHandle createProcessSuccess
(proc "debconf-set-selections" []) $ \h -> do
- forM_ vals $ \(template, tmpltype, value) ->
- hPutStrLn h $ unwords [package, template, tmpltype, value]
+ forM_ vals $ \(tmpl, tmpltype, value) ->
+ hPutStrLn h $ unwords [package, tmpl, tmpltype, value]
hClose h
reconfigure = cmdProperty "dpkg-reconfigure" ["-fnone", package]
+
+-- | Ensures that a service is installed and running.
+--
+-- Assumes that there is a 1:1 mapping between service names and apt
+-- package names.
+serviceInstalledRunning :: Package -> Property
+serviceInstalledRunning svc = Service.running svc `requires` installed [svc]
diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs
index dc5073d3..875c1f9a 100644
--- a/Propellor/Property/Cmd.hs
+++ b/Propellor/Property/Cmd.hs
@@ -1,17 +1,17 @@
+{-# LANGUAGE PackageImports #-}
+
module Propellor.Property.Cmd (
cmdProperty,
cmdProperty',
scriptProperty,
userScriptProperty,
- serviceRunning,
) where
-import Control.Monad
import Control.Applicative
import Data.List
+import "mtl" Control.Monad.Reader
import Propellor.Types
-import Propellor.Engine
import Utility.Monad
import Utility.SafeCommand
import Utility.Env
@@ -25,7 +25,7 @@ cmdProperty cmd params = cmdProperty' cmd params []
-- | A property that can be satisfied by running a command,
-- with added environment.
cmdProperty' :: String -> [String] -> [(String, String)] -> Property
-cmdProperty' cmd params env = Property desc $ do
+cmdProperty' cmd params env = Property desc $ liftIO $ do
env' <- addEntries env <$> getEnvironment
ifM (boolSystemEnv cmd (map Param params) (Just env'))
( return MadeChange
@@ -46,14 +46,3 @@ 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
--- we can do is try to start the service, and if it fails, assume
--- this means it's already running.
-serviceRunning :: String -> Property
-serviceRunning svc = Property ("running " ++ svc) $ do
- void $ ensureProperty $
- scriptProperty ["service " ++ shellEscape svc ++ " start >/dev/null 2>&1 || true"]
- return NoChange
diff --git a/Propellor/Property/Cron.hs b/Propellor/Property/Cron.hs
index 30bdb510..fa6019ea 100644
--- a/Propellor/Property/Cron.hs
+++ b/Propellor/Property/Cron.hs
@@ -18,8 +18,7 @@ job desc times user cddir command = ("/etc/cron.d/" ++ desc) `File.hasContent`
, ""
, times ++ "\t" ++ user ++ "\t" ++ "cd " ++ cddir ++ " && " ++ command
]
- `requires` Apt.installed ["cron"]
- `requires` serviceRunning "cron"
+ `requires` Apt.serviceInstalledRunning "cron"
`describe` ("cronned " ++ desc)
-- | Installs a cron job, and runs it niced and ioniced.
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
new file mode 100644
index 00000000..34e790d9
--- /dev/null
+++ b/Propellor/Property/Dns.hs
@@ -0,0 +1,63 @@
+module Propellor.Property.Dns where
+
+import Propellor
+import Propellor.Property.File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+namedconf :: FilePath
+namedconf = "/etc/bind/named.conf.local"
+
+data Zone = Zone
+ { zdomain :: Domain
+ , ztype :: Type
+ , zfile :: FilePath
+ , zmasters :: [IPAddr]
+ , zconfiglines :: [String]
+ }
+
+zoneDesc :: Zone -> String
+zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"
+
+type IPAddr = String
+
+type Domain = String
+
+data Type = Master | Secondary
+ deriving (Show, Eq)
+
+secondary :: Domain -> [IPAddr] -> Zone
+secondary domain masters = Zone
+ { zdomain = domain
+ , ztype = Secondary
+ , zfile = "db." ++ domain
+ , zmasters = masters
+ , zconfiglines = ["allow-transfer { }"]
+ }
+
+zoneStanza :: Zone -> [Line]
+zoneStanza z =
+ [ "// automatically generated by propellor"
+ , "zone \"" ++ zdomain z ++ "\" {"
+ , cfgline "type" (if ztype z == Master then "master" else "slave")
+ , cfgline "file" ("\"" ++ zfile z ++ "\"")
+ ] ++
+ (if null (zmasters z) then [] else mastersblock) ++
+ (map (\l -> "\t" ++ l ++ ";") (zconfiglines z)) ++
+ [ "};"
+ , ""
+ ]
+ where
+ cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
+ mastersblock =
+ [ "\tmasters {" ] ++
+ (map (\ip -> "\t\t" ++ ip ++ ";") (zmasters z)) ++
+ [ "\t};" ]
+
+-- | Rewrites the whole named.conf.local file to serve the specificed
+-- zones.
+zones :: [Zone] -> Property
+zones zs = hasContent namedconf (concatMap zoneStanza zs)
+ `describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))
+ `requires` Apt.serviceInstalledRunning "bind9"
+ `onChange` Service.reloaded "bind9"
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index b573e641..d2555ea5 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes, BangPatterns #-}
+{-# LANGUAGE BangPatterns #-}
-- | Docker support for propellor
--
@@ -9,6 +9,7 @@ module Propellor.Property.Docker where
import Propellor
import Propellor.SimpleSh
+import Propellor.Types.Attr
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Docker.Shim as Shim
@@ -32,6 +33,25 @@ configured = Property "docker configured" go `requires` installed
installed :: Property
installed = Apt.installed ["docker.io"]
+-- | A short descriptive name for a container.
+-- Should not contain whitespace or other unusual characters,
+-- only [a-zA-Z0-9_-] are allowed
+type ContainerName = String
+
+-- | Starts accumulating the properties of a Docker container.
+--
+-- > container "web-server" "debian"
+-- > & publish "80:80"
+-- > & Apt.installed {"apache2"]
+-- > & ...
+container :: ContainerName -> Image -> Host
+container cn image = Host [] (\_ -> attr)
+ where
+ attr = (newAttr (cn2hn cn)) { _dockerImage = Just image }
+
+cn2hn :: ContainerName -> HostName
+cn2hn cn = cn ++ ".docker"
+
-- | 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.
@@ -39,44 +59,61 @@ installed = Apt.installed ["docker.io"]
-- Reverting this property ensures that the container is stopped and
-- removed.
docked
- :: (HostName -> ContainerName -> Maybe (Container))
- -> HostName
+ :: [Host]
-> ContainerName
-> RevertableProperty
-docked findc hn cn = findContainer findc hn cn $
- \(Container image containerprops) ->
- let setup = provisionContainer cid
- `requires`
- runningContainer cid image containerprops
- `requires`
- installed
- teardown = combineProperties ("undocked " ++ fromContainerId cid)
- [ stoppedContainer cid
+docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown)
+ where
+ go desc a = Property (desc ++ " " ++ cn) $ do
+ hn <- getHostName
+ let cid = ContainerId hn cn
+ ensureProperties [findContainer hosts cid cn $ a cid]
+
+ setup cid (Container image runparams) =
+ provisionContainer cid
+ `requires`
+ runningContainer cid image runparams
+ `requires`
+ installed
+
+ teardown cid (Container image _runparams) =
+ combineProperties ("undocked " ++ fromContainerId cid)
+ [ stoppedContainer cid
, Property ("cleaned up " ++ fromContainerId cid) $
- report <$> mapM id
+ liftIO $ report <$> mapM id
[ removeContainer cid
, removeImage image
]
]
- in RevertableProperty setup teardown
- where
- cid = ContainerId hn cn
findContainer
- :: (HostName -> ContainerName -> Maybe (Container))
- -> HostName
+ :: [Host]
+ -> ContainerId
-> ContainerName
- -> (Container -> RevertableProperty)
- -> RevertableProperty
-findContainer findc hn cn mk = case findc hn cn of
- Nothing -> RevertableProperty cantfind cantfind
- Just container -> mk container
+ -> (Container -> Property)
+ -> Property
+findContainer hosts cid cn mk = case findHost hosts (cn2hn cn) of
+ Nothing -> cantfind
+ Just h -> maybe cantfind mk (mkContainer cid h)
where
- cid = ContainerId hn cn
- cantfind = containerDesc (ContainerId hn cn) $ Property "" $ do
- warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
+ cantfind = containerDesc cid $ Property "" $ do
+ liftIO $ warningMessage $
+ "missing definition for docker container \"" ++ cn2hn cn
return FailedChange
+mkContainer :: ContainerId -> Host -> Maybe Container
+mkContainer cid@(ContainerId hn _cn) h = Container
+ <$> _dockerImage attr
+ <*> pure (map (\a -> a hn) (_dockerRunParams attr))
+ where
+ attr = hostAttr h'
+ h' = h
+ -- expose propellor directory inside the container
+ & volume (localdir++":"++localdir)
+ -- name the container in a predictable way so we
+ -- and the user can easily find it later
+ & name (fromContainerId cid)
+
-- | Causes *any* docker images that are not in use by running containers to
-- be deleted. And deletes any containers that propellor has set up
-- before that are not currently running. Does not delete any containers
@@ -90,34 +127,11 @@ garbageCollected = propertyList "docker garbage collected"
]
where
gccontainers = Property "docker containers garbage collected" $
- report <$> (mapM removeContainer =<< listContainers AllContainers)
+ liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
gcimages = Property "docker images garbage collected" $ do
- report <$> (mapM removeImage =<< listImages)
-
--- | Pass to defaultMain to add docker containers.
--- You need to provide the function mapping from
--- HostName and ContainerName to the Container to use.
-containerProperties
- :: (HostName -> ContainerName -> Maybe (Container))
- -> (HostName -> Maybe [Property])
-containerProperties findcontainer = \h -> case toContainerId h of
- Nothing -> Nothing
- Just cid@(ContainerId hn cn) ->
- case findcontainer hn cn of
- Nothing -> Nothing
- Just (Container _ cprops) ->
- Just $ map (containerDesc cid) $
- fromContainerized cprops
-
--- | This type is used to configure a docker container.
--- It has an image, and a list of Properties, but these
--- properties are Containerized; they can specify
--- things about the container's configuration, in
--- addition to properties of the system inside the
--- container.
-data Container = Container Image [Containerized Property]
+ liftIO $ report <$> (mapM removeImage =<< listImages)
-data Containerized a = Containerized [HostName -> RunParam] a
+data Container = Container Image [RunParam]
-- | Parameters to pass to `docker run` when creating a container.
type RunParam = String
@@ -125,62 +139,50 @@ type RunParam = String
-- | A docker image, that can be used to run a container.
type Image = String
--- | A short descriptive name for a container.
--- Should not contain whitespace or other unusual characters,
--- only [a-zA-Z0-9_.-] are allowed
-type ContainerName = String
-
--- | Lift a Property to apply inside a container.
-inside1 :: Property -> Containerized Property
-inside1 = Containerized []
-
-inside :: [Property] -> Containerized Property
-inside = Containerized [] . combineProperties "provision"
-
-- | Set custom dns server for container.
-dns :: String -> Containerized Property
+dns :: String -> AttrProperty
dns = runProp "dns"
-- | Set container host name.
-hostname :: String -> Containerized Property
+hostname :: String -> AttrProperty
hostname = runProp "hostname"
-- | Set name for container. (Normally done automatically.)
-name :: String -> Containerized Property
+name :: String -> AttrProperty
name = runProp "name"
-- | Publish a container's port to the host
-- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
-publish :: String -> Containerized Property
+publish :: String -> AttrProperty
publish = runProp "publish"
-- | Username or UID for container.
-user :: String -> Containerized Property
+user :: String -> AttrProperty
user = runProp "user"
-- | Mount a volume
-- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro]
-- With just a directory, creates a volume in the container.
-volume :: String -> Containerized Property
+volume :: String -> AttrProperty
volume = runProp "volume"
-- | Mount a volume from the specified container into the current
-- container.
-volumes_from :: ContainerName -> Containerized Property
+volumes_from :: ContainerName -> AttrProperty
volumes_from cn = genProp "volumes-from" $ \hn ->
fromContainerId (ContainerId hn cn)
-- | Work dir inside the container.
-workdir :: String -> Containerized Property
+workdir :: String -> AttrProperty
workdir = runProp "workdir"
-- | Memory limit for container.
--Format: <number><optional unit>, where unit = b, k, m or g
-memory :: String -> Containerized Property
+memory :: String -> AttrProperty
memory = runProp "memory"
-- | Link with another container on the same host.
-link :: ContainerName -> ContainerAlias -> Containerized Property
+link :: ContainerName -> ContainerAlias -> AttrProperty
link linkwith alias = genProp "link" $ \hn ->
fromContainerId (ContainerId hn linkwith) ++ ":" ++ alias
@@ -199,16 +201,6 @@ data ContainerId = ContainerId HostName ContainerName
data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
deriving (Read, Show, Eq)
-getRunParams :: HostName -> [Containerized a] -> [RunParam]
-getRunParams hn l = concatMap get l
- where
- get (Containerized ps _) = map (\a -> a hn ) ps
-
-fromContainerized :: forall a. [Containerized a] -> [a]
-fromContainerized l = map get l
- where
- get (Containerized _ a) = a
-
ident2id :: ContainerIdent -> ContainerId
ident2id (ContainerIdent _ hn cn _) = ContainerId hn cn
@@ -226,32 +218,32 @@ toContainerId s
fromContainerId :: ContainerId -> String
fromContainerId (ContainerId hn cn) = cn++"."++hn++myContainerSuffix
+containerHostName :: ContainerId -> HostName
+containerHostName (ContainerId _ cn) = cn2hn cn
+
myContainerSuffix :: String
myContainerSuffix = ".propellor"
-containerFrom :: Image -> [Containerized Property] -> Container
-containerFrom = Container
-
containerDesc :: ContainerId -> Property -> Property
containerDesc cid p = p `describe` desc
where
desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p
-runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property
-runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc cid $ Property "running" $ do
- l <- listContainers RunningContainers
+runningContainer :: ContainerId -> Image -> [RunParam] -> Property
+runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ Property "running" $ do
+ l <- liftIO $ listContainers RunningContainers
if cid `elem` l
then do
-- Check if the ident has changed; if so the
-- parameters of the container differ and it must
-- be restarted.
- runningident <- getrunningident
+ runningident <- liftIO $ getrunningident
if runningident == Just ident
- then return NoChange
+ then noChange
else do
- void $ stopContainer cid
+ void $ liftIO $ stopContainer cid
restartcontainer
- else ifM (elem cid <$> listContainers AllContainers)
+ else ifM (liftIO $ elem cid <$> listContainers AllContainers)
( restartcontainer
, go image
)
@@ -259,8 +251,8 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
ident = ContainerIdent image hn cn runps
restartcontainer = do
- oldimage <- fromMaybe image <$> commitContainer cid
- void $ removeContainer cid
+ oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
+ void $ liftIO $ removeContainer cid
go oldimage
getrunningident :: IO (Maybe ContainerIdent)
@@ -271,19 +263,12 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
extractident :: [Resp] -> Maybe ContainerIdent
extractident = headMaybe . catMaybes . map readish . catMaybes . map getStdout
- runps = getRunParams hn $ containerprops ++
- -- expose propellor directory inside the container
- [ volume (localdir++":"++localdir)
- -- name the container in a predictable way so we
- -- and the user can easily find it later
- , name (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)
+ liftIO $ do
+ clearProvisionedFlag cid
+ createDirectoryIfMissing True (takeDirectory $ identFile cid)
+ shim <- liftIO $ Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
+ liftIO $ writeFile (identFile cid) (show ident)
ensureProperty $ boolProperty "run" $ runContainer img
(runps ++ ["-i", "-d", "-t"])
[shim, "--docker", fromContainerId cid]
@@ -317,7 +302,7 @@ chain s = case toContainerId s of
-- to avoid ever provisioning twice at the same time.
whenM (checkProvisionedFlag cid) $ do
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
- unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $
+ unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ containerHostName cid]) $
warningMessage "Boot provision failed!"
void $ async $ job reapzombies
void $ async $ job $ simpleSh $ namedPipe cid
@@ -339,14 +324,14 @@ chain s = case toContainerId s of
-- being run. So, retry connections to the client for up to
-- 1 minute.
provisionContainer :: ContainerId -> Property
-provisionContainer cid = containerDesc cid $ Property "provision" $ do
+provisionContainer cid = containerDesc cid $ Property "provision" $ liftIO $ do
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
where
- params = ["--continue", show $ Chain $ fromContainerId cid]
+ params = ["--continue", show $ Chain $ containerHostName cid]
go lastline (v:rest) = case v of
StdoutLine s -> do
@@ -372,8 +357,8 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId
stoppedContainer :: ContainerId -> Property
stoppedContainer cid = containerDesc cid $ Property desc $
- ifM (elem cid <$> listContainers RunningContainers)
- ( cleanup `after` ensureProperty
+ ifM (liftIO $ elem cid <$> listContainers RunningContainers)
+ ( liftIO cleanup `after` ensureProperty
(boolProperty desc $ stopContainer cid)
, return NoChange
)
@@ -420,17 +405,18 @@ listContainers status =
listImages :: IO [Image]
listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
-runProp :: String -> RunParam -> Containerized Property
-runProp field val = Containerized
- [\_ -> "--" ++ param]
- (Property (param) (return NoChange))
+runProp :: String -> RunParam -> AttrProperty
+runProp field val = AttrProperty prop $ \attr ->
+ attr { _dockerRunParams = _dockerRunParams attr ++ [\_ -> "--"++param] }
where
param = field++"="++val
+ prop = Property (param) (return NoChange)
-genProp :: String -> (HostName -> RunParam) -> Containerized Property
-genProp field mkval = Containerized
- [\h -> "--" ++ field ++ "=" ++ mkval h]
- (Property field (return NoChange))
+genProp :: String -> (HostName -> RunParam) -> AttrProperty
+genProp field mkval = AttrProperty prop $ \attr ->
+ attr { _dockerRunParams = _dockerRunParams attr ++ [\hn -> "--"++field++"=" ++ mkval hn] }
+ where
+ prop = Property field (return NoChange)
-- | The ContainerIdent of a container is written to
-- /.propellor-ident inside it. This can be checked to see if
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
index 80c69d9b..10dee75e 100644
--- a/Propellor/Property/File.hs
+++ b/Propellor/Property/File.hs
@@ -11,6 +11,13 @@ hasContent :: FilePath -> [Line] -> Property
f `hasContent` newcontent = fileProperty ("replace " ++ f)
(\_oldcontent -> newcontent) f
+-- | Ensures a file has contents that comes from PrivData.
+-- Note: Does not do anything with the permissions of the file to prevent
+-- it from being seen.
+hasPrivContent :: FilePath -> Property
+hasPrivContent f = Property ("privcontent " ++ f) $
+ withPrivData (PrivFile f) (\v -> ensureProperty $ f `hasContent` lines v)
+
-- | 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
@@ -31,10 +38,10 @@ notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $
makeChange $ nukeFile f
fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
-fileProperty desc a f = Property desc $ go =<< doesFileExist f
+fileProperty desc a f = Property desc $ go =<< liftIO (doesFileExist f)
where
go True = do
- ls <- lines <$> readFile f
+ ls <- liftIO $ lines <$> readFile f
let ls' = a ls
if ls' == ls
then noChange
@@ -51,3 +58,13 @@ fileProperty desc a f = Property desc $ go =<< doesFileExist f
dirExists :: FilePath -> Property
dirExists d = check (not <$> doesDirectoryExist d) $ Property (d ++ " exists") $
makeChange $ createDirectoryIfMissing True d
+
+-- | Ensures that a file/dir has the specified owner and group.
+ownerGroup :: FilePath -> UserName -> GroupName -> Property
+ownerGroup f owner group = Property (f ++ " owner " ++ og) $ do
+ r <- ensureProperty $ cmdProperty "chown" [og, f]
+ if r == FailedChange
+ then return r
+ else noChange
+ where
+ og = owner ++ ":" ++ group
diff --git a/Propellor/Property/Git.hs b/Propellor/Property/Git.hs
new file mode 100644
index 00000000..c0494160
--- /dev/null
+++ b/Propellor/Property/Git.hs
@@ -0,0 +1,48 @@
+module Propellor.Property.Git where
+
+import Propellor
+import Propellor.Property.File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+import Data.List
+
+-- | Exports all git repos in a directory (that user nobody can read)
+-- using git-daemon, run from inetd.
+--
+-- Note that reverting this property does not remove or stop inetd.
+daemonRunning :: FilePath -> RevertableProperty
+daemonRunning exportdir = RevertableProperty setup unsetup
+ where
+ setup = containsLine conf (mkl "tcp4")
+ `requires`
+ containsLine conf (mkl "tcp6")
+ `requires`
+ dirExists exportdir
+ `requires`
+ Apt.serviceInstalledRunning "openbsd-inetd"
+ `onChange`
+ Service.running "openbsd-inetd"
+ `describe` ("git-daemon exporting " ++ exportdir)
+ unsetup = lacksLine conf (mkl "tcp4")
+ `requires`
+ lacksLine conf (mkl "tcp6")
+ `onChange`
+ Service.reloaded "openbsd-inetd"
+
+ conf = "/etc/inetd.conf"
+
+ mkl tcpv = intercalate "\t"
+ [ "git"
+ , "stream"
+ , tcpv
+ , "nowait"
+ , "nobody"
+ , "/usr/bin/git"
+ , "git"
+ , "daemon"
+ , "--inetd"
+ , "--export-all"
+ , "--base-path=" ++ exportdir
+ , exportdir
+ ]
diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs
index 26635374..03613ac9 100644
--- a/Propellor/Property/Hostname.hs
+++ b/Propellor/Property/Hostname.hs
@@ -3,21 +3,24 @@ 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.
+-- | Ensures that the hostname is set to the HostAttr value.
+-- Configures both /etc/hostname and the current hostname.
--
--- When provided with a FQDN, also configures /etc/hosts,
+-- When the hostname is 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 = combineProperties desc go
- `onChange` cmdProperty "hostname" [host]
+sane :: Property
+sane = Property ("sane hostname") (ensureProperty . setTo =<< getHostName)
+
+setTo :: HostName -> Property
+setTo hn = combineProperties desc go
+ `onChange` cmdProperty "hostname" [basehost]
where
- desc = "hostname " ++ hostname
- (host, domain) = separate (== '.') hostname
+ desc = "hostname " ++ hn
+ (basehost, domain) = separate (== '.') hn
go = catMaybes
- [ Just $ "/etc/hostname" `File.hasContent` [host]
+ [ Just $ "/etc/hostname" `File.hasContent` [basehost]
, if null domain
then Nothing
else Just $ File.fileProperty desc
@@ -25,7 +28,7 @@ set hostname = combineProperties desc go
]
hostip = "127.0.1.1"
- hostline = hostip ++ "\t" ++ hostname ++ " " ++ host
+ hostline = hostip ++ "\t" ++ hn ++ " " ++ basehost
addhostline ls = hostline : filter (not . hashostip) ls
hashostip l = headMaybe (words l) == Just hostip
diff --git a/Propellor/Property/Network.hs b/Propellor/Property/Network.hs
index eae5828f..6009778a 100644
--- a/Propellor/Property/Network.hs
+++ b/Propellor/Property/Network.hs
@@ -20,6 +20,7 @@ ipv6to4 = fileProperty "ipv6to4" go interfaces
, "\taddress 2002:5044:5531::1"
, "\tnetmask 64"
, "\tgateway ::192.88.99.1"
+ , "auto sit0"
, "# End automatically added by propeller"
]
diff --git a/Propellor/Property/OpenId.hs b/Propellor/Property/OpenId.hs
new file mode 100644
index 00000000..c397bdb8
--- /dev/null
+++ b/Propellor/Property/OpenId.hs
@@ -0,0 +1,26 @@
+module Propellor.Property.OpenId where
+
+import Propellor
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+import Data.List
+
+providerFor :: [UserName] -> String -> Property
+providerFor users baseurl = propertyList desc $
+ [ Apt.serviceInstalledRunning "apache2"
+ , Apt.installed ["simpleid"]
+ `onChange` Service.restarted "apache2"
+ , File.fileProperty desc
+ (map setbaseurl) "/etc/simpleid/config.inc"
+ ] ++ map identfile users
+ where
+ identfile u = File.hasPrivContent $ concat
+ [ "/var/lib/simpleid/identities/", u, ".identity" ]
+ url = "http://"++baseurl++"/simpleid"
+ desc = "openid provider " ++ url
+ setbaseurl l
+ | "SIMPLEID_BASE_URL" `isInfixOf` l =
+ "define('SIMPLEID_BASE_URL', '"++url++"');"
+ | otherwise = l
diff --git a/Propellor/Property/Scheduled.hs b/Propellor/Property/Scheduled.hs
new file mode 100644
index 00000000..8341765e
--- /dev/null
+++ b/Propellor/Property/Scheduled.hs
@@ -0,0 +1,67 @@
+module Propellor.Property.Scheduled
+ ( period
+ , periodParse
+ , Recurrance(..)
+ , WeekDay
+ , MonthDay
+ , YearDay
+ ) where
+
+import Propellor
+import Utility.Scheduled
+
+import Data.Time.Clock
+import Data.Time.LocalTime
+import qualified Data.Map as M
+
+-- | Makes a Property only be checked every so often.
+--
+-- This uses the description of the Property to keep track of when it was
+-- last run.
+period :: Property -> Recurrance -> Property
+period prop recurrance = Property desc $ do
+ lasttime <- liftIO $ getLastChecked (propertyDesc prop)
+ nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
+ t <- liftIO localNow
+ if Just t >= nexttime
+ then do
+ r <- ensureProperty prop
+ liftIO $ setLastChecked t (propertyDesc prop)
+ return r
+ else noChange
+ where
+ schedule = Schedule recurrance AnyTime
+ desc = propertyDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
+
+-- | Like period, but parse a human-friendly string.
+periodParse :: Property -> String -> Property
+periodParse prop s = case toRecurrance s of
+ Just recurrance -> period prop recurrance
+ Nothing -> Property "periodParse" $ do
+ liftIO $ warningMessage $ "failed periodParse: " ++ s
+ noChange
+
+lastCheckedFile :: FilePath
+lastCheckedFile = localdir </> ".lastchecked"
+
+getLastChecked :: Desc -> IO (Maybe LocalTime)
+getLastChecked desc = M.lookup desc <$> readLastChecked
+
+localNow :: IO LocalTime
+localNow = do
+ now <- getCurrentTime
+ tz <- getTimeZone now
+ return $ utcToLocalTime tz now
+
+setLastChecked :: LocalTime -> Desc -> IO ()
+setLastChecked time desc = do
+ m <- readLastChecked
+ writeLastChecked (M.insert desc time m)
+
+readLastChecked :: IO (M.Map Desc LocalTime)
+readLastChecked = fromMaybe M.empty <$> catchDefaultIO Nothing go
+ where
+ go = readish <$> readFile lastCheckedFile
+
+writeLastChecked :: M.Map Desc LocalTime -> IO ()
+writeLastChecked = writeFile lastCheckedFile . show
diff --git a/Propellor/Property/Service.hs b/Propellor/Property/Service.hs
new file mode 100644
index 00000000..c6498e57
--- /dev/null
+++ b/Propellor/Property/Service.hs
@@ -0,0 +1,31 @@
+module Propellor.Property.Service where
+
+import Propellor
+import Utility.SafeCommand
+
+type ServiceName = String
+
+-- | Ensures that a service is running. Does not ensure that
+-- any package providing that service is installed. See
+-- Apt.serviceInstalledRunning
+--
+-- Note that due to the general poor state of init scripts, the best
+-- we can do is try to start the service, and if it fails, assume
+-- this means it's already running.
+running :: ServiceName -> Property
+running svc = Property ("running " ++ svc) $ do
+ void $ ensureProperty $
+ scriptProperty ["service " ++ shellEscape svc ++ " start >/dev/null 2>&1 || true"]
+ return NoChange
+
+restarted :: ServiceName -> Property
+restarted svc = Property ("restarted " ++ svc) $ do
+ void $ ensureProperty $
+ scriptProperty ["service " ++ shellEscape svc ++ " restart >/dev/null 2>&1 || true"]
+ return NoChange
+
+reloaded :: ServiceName -> Property
+reloaded svc = Property ("reloaded " ++ svc) $ do
+ void $ ensureProperty $
+ scriptProperty ["service " ++ shellEscape svc ++ " reload >/dev/null 2>&1 || true"]
+ return NoChange
diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 149c8e6c..204a9ca7 100644
--- a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -24,7 +24,7 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder"
, Apt.buildDep ["git-annex"]
, Apt.installed ["git", "rsync", "moreutils", "ca-certificates",
"liblockfile-simple-perl", "cabal-install", "vim", "less"]
- , serviceRunning "cron" `requires` Apt.installed ["cron"]
+ , Apt.serviceInstalledRunning "cron"
, User.accountFor builduser
, check (not <$> doesDirectoryExist gitbuilderdir) $ userScriptProperty builduser
[ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir
@@ -44,12 +44,13 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder"
let f = homedir </> "rsyncpassword"
if rsyncupload
then withPrivData (Password builduser) $ \p -> do
- oldp <- catchDefaultIO "" $ readFileStrict f
+ oldp <- liftIO $ catchDefaultIO "" $
+ readFileStrict f
if p /= oldp
then makeChange $ writeFile f p
else noChange
else do
- ifM (doesFileExist f)
+ ifM (liftIO $ doesFileExist f)
( noChange
, makeChange $ writeFile f "no password configured"
)
diff --git a/Propellor/Property/SiteSpecific/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs
index 38e0cb97..1ba56b94 100644
--- a/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/Propellor/Property/SiteSpecific/GitHome.hs
@@ -8,8 +8,8 @@ import Utility.SafeCommand
-- | 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)
- `requires` Apt.installed ["git", "myrepos"]
+ Property ("githome " ++ user) (go =<< liftIO (homedir user))
+ `requires` Apt.installed ["git"]
where
go Nothing = noChange
go (Just home) = do
@@ -20,7 +20,7 @@ installedFor user = check (not <$> hasGitDir user) $
moveout tmpdir home
, Property "rmdir" $ makeChange $ void $
catchMaybeIO $ removeDirectory tmpdir
- , userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; mr checkout; bin/fixups"]
+ , userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; bin/mr checkout; bin/fixups"]
]
moveout tmpdir home = do
fs <- dirContents tmpdir
diff --git a/Propellor/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index 029064dd..46373170 100644
--- a/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -6,8 +6,8 @@ module Propellor.Property.SiteSpecific.JoeySites where
import Propellor
import qualified Propellor.Property.Apt as Apt
-oldUseNetshellBox :: Property
-oldUseNetshellBox = check (not <$> Apt.isInstalled "oldusenet") $
+oldUseNetShellBox :: Property
+oldUseNetShellBox = check (not <$> Apt.isInstalled "oldusenet") $
propertyList ("olduse.net shellbox")
[ Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
`describe` "olduse.net build deps"
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
index 36766f56..59845f8f 100644
--- a/Propellor/Property/Ssh.hs
+++ b/Propellor/Property/Ssh.hs
@@ -53,7 +53,7 @@ uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
`onChange` restartSshd
where
prop = Property "ssh unique host keys" $ do
- void $ boolSystem "sh"
+ void $ liftIO $ boolSystem "sh"
[ Param "-c"
, Param "rm -f /etc/ssh/ssh_host_*"
]
diff --git a/Propellor/Property/Sudo.hs b/Propellor/Property/Sudo.hs
index 68b8d056..66ceb580 100644
--- a/Propellor/Property/Sudo.hs
+++ b/Propellor/Property/Sudo.hs
@@ -13,7 +13,7 @@ enabledFor :: UserName -> Property
enabledFor user = Property desc go `requires` Apt.installed ["sudo"]
where
go = do
- locked <- isLockedPassword user
+ locked <- liftIO $ isLockedPassword user
ensureProperty $
fileProperty desc
(modify locked . filter (wanted locked))