summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFĂ©lix Sipma2016-03-07 14:29:07 +0100
committerJoey Hess2016-03-07 16:31:52 -0400
commit85e58f49ca676a3cfb34c6bfb27bb5d0b39e83f4 (patch)
tree4c679447a9ba78feb48cde256cd646941279c15c
parent9003983998e50f11e85e7f29e3eae3c486c0f6d0 (diff)
add fromPort function
(cherry picked from commit c3a23f89092d1ef8367c37ab8993ea7031124f4b)
-rw-r--r--src/Propellor/Property/Apache.hs22
-rw-r--r--src/Propellor/Property/Docker.hs26
-rw-r--r--src/Propellor/Property/Firewall.hs8
-rw-r--r--src/Propellor/Property/Munin.hs3
-rw-r--r--src/Propellor/Property/OpenId.hs8
-rw-r--r--src/Propellor/Property/Systemd.hs12
-rw-r--r--src/Propellor/Types/OS.hs4
7 files changed, 43 insertions, 40 deletions
diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs
index dee7a5fc..e107cb9f 100644
--- a/src/Propellor/Property/Apache.hs
+++ b/src/Propellor/Property/Apache.hs
@@ -27,7 +27,7 @@ siteEnabled' domain cf = combineProperties ("apache site enabled " ++ domain)
[ siteAvailable domain cf
`requires` installed
`onChange` reloaded
- , check (not <$> isenabled)
+ , check (not <$> isenabled)
(cmdProperty "a2ensite" ["--quiet", domain])
`requires` installed
`onChange` reloaded
@@ -37,7 +37,7 @@ siteEnabled' domain cf = combineProperties ("apache site enabled " ++ domain)
siteDisabled :: Domain -> Property NoInfo
siteDisabled domain = combineProperties
- ("apache site disabled " ++ domain)
+ ("apache site disabled " ++ domain)
(map File.notPresent (siteCfg domain))
`onChange` (cmdProperty "a2dissite" ["--quiet", domain] `assume` MadeChange)
`requires` installed
@@ -72,7 +72,7 @@ listenPorts :: [Port] -> Property NoInfo
listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps
`onChange` restarted
where
- portline (Port n) = "Listen " ++ show n
+ portline port = "Listen " ++ fromPort port
-- This is a list of config files because different versions of apache
-- use different filenames. Propellor simply writes them all.
@@ -82,7 +82,7 @@ siteCfg domain =
[ "/etc/apache2/sites-available/" ++ domain
-- Debian 2.4+
, "/etc/apache2/sites-available/" ++ domain ++ ".conf"
- ]
+ ]
-- | Configure apache to use SNI to differentiate between
-- https hosts.
@@ -130,13 +130,13 @@ type WebRoot = FilePath
-- | A basic virtual host, publishing a directory, and logging to
-- the combined apache log file. Not https capable.
virtualHost :: Domain -> Port -> WebRoot -> RevertableProperty NoInfo
-virtualHost domain (Port p) docroot = virtualHost' domain (Port p) docroot []
+virtualHost domain port docroot = virtualHost' domain port docroot []
-- | Like `virtualHost` but with additional config lines added.
virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty NoInfo
-virtualHost' domain (Port p) docroot addedcfg = siteEnabled domain $
- [ "<VirtualHost *:"++show p++">"
- , "ServerName "++domain++":"++show p
+virtualHost' domain port docroot addedcfg = siteEnabled domain $
+ [ "<VirtualHost *:" ++ fromPort port ++ ">"
+ , "ServerName " ++ domain ++ ":" ++ fromPort port
, "DocumentRoot " ++ docroot
, "ErrorLog /var/log/apache2/error.log"
, "LogLevel warn"
@@ -201,9 +201,9 @@ httpsVirtualHost' domain docroot letos addedcfg = setup <!> teardown
, "SSLCertificateChainFile " ++ LetsEncrypt.chainFile domain
]
sslconffile s = "/etc/apache2/sites-available/ssl/" ++ domain ++ "/" ++ s ++ ".conf"
- vhost (Port p) ls =
- [ "<VirtualHost *:"++show p++">"
- , "ServerName "++domain++":"++show p
+ vhost p ls =
+ [ "<VirtualHost *:" ++ fromPort p ++">"
+ , "ServerName " ++ domain ++ ":" ++ fromPort p
, "DocumentRoot " ++ docroot
, "ErrorLog /var/log/apache2/error.log"
, "LogLevel warn"
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 932ba2c1..ebc0b301 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -75,7 +75,7 @@ configured :: Property HasInfo
configured = prop `requires` installed
where
prop = withPrivData src anyContext $ \getcfg ->
- property "docker configured" $ getcfg $ \cfg -> ensureProperty $
+ property "docker configured" $ getcfg $ \cfg -> ensureProperty $
"/root/.dockercfg" `File.hasContent` privDataLines cfg
src = PrivDataSourceFileFromCommand DockerAuthentication
"/root/.dockercfg" "docker login"
@@ -115,7 +115,7 @@ container cn image = Container image (Host cn [] info)
info = dockerInfo mempty
-- | 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.
--
@@ -186,7 +186,7 @@ propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p'
cn = hostName h
mkContainerInfo :: ContainerId -> Container -> ContainerInfo
-mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
+mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
ContainerInfo img runparams
where
runparams = map (\(DockerRunParam mkparam) -> mkparam hn)
@@ -233,7 +233,7 @@ tweaked = cmdProperty "sh"
`assume` NoChange
`describe` "tweaked for docker"
--- | Configures the kernel to respect docker memory limits.
+-- | Configures the kernel to respect docker memory limits.
--
-- This assumes the system boots using grub 2. And that you don't need any
-- other GRUB_CMDLINE_LINUX_DEFAULT settings.
@@ -241,7 +241,7 @@ tweaked = cmdProperty "sh"
-- Only takes effect after reboot. (Not automated.)
memoryLimited :: Property NoInfo
memoryLimited = "/etc/default/grub" `File.containsLine` cfg
- `describe` "docker memory limited"
+ `describe` "docker memory limited"
`onChange` (cmdProperty "update-grub" [] `assume` MadeChange)
where
cmdline = "cgroup_enable=memory swapaccount=1"
@@ -315,7 +315,7 @@ class Publishable p where
toPublish :: p -> String
instance Publishable (Bound Port) where
- toPublish p = show (hostSide p) ++ ":" ++ show (containerSide p)
+ toPublish p = fromPort (hostSide p) ++ ":" ++ fromPort (containerSide p)
-- | string format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort
instance Publishable String where
@@ -355,7 +355,7 @@ volumes_from :: ContainerName -> Property HasInfo
volumes_from cn = genProp "volumes-from" $ \hn ->
fromContainerId (ContainerId hn cn)
--- | Work dir inside the container.
+-- | Work dir inside the container.
workdir :: String -> Property HasInfo
workdir = runProp "workdir"
@@ -409,7 +409,7 @@ environment (k, v) = runProp "env" $ k ++ "=" ++ v
-- | A container is identified by its name, and the host
-- on which it's deployed.
-data ContainerId = ContainerId
+data ContainerId = ContainerId
{ containerHostName :: HostName
, containerName :: ContainerName
}
@@ -503,7 +503,7 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
v <- a
case v of
Right Nothing -> do
- threadDelaySeconds (Seconds 1)
+ threadDelaySeconds (Seconds 1)
retry (n-1) a
_ -> return v
@@ -569,7 +569,7 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d
r <- withHandle StdoutHandle createProcessSuccess p $
processChainOutput
when (r /= FailedChange) $
- setProvisionedFlag cid
+ setProvisionedFlag cid
return r
toChain :: ContainerId -> CmdLine
@@ -600,9 +600,9 @@ startContainer :: ContainerId -> IO Bool
startContainer cid = boolSystem dockercmd [Param "start", Param $ fromContainerId cid ]
stoppedContainer :: ContainerId -> Property NoInfo
-stoppedContainer cid = containerDesc cid $ property desc $
+stoppedContainer cid = containerDesc cid $ property desc $
ifM (liftIO $ elem cid <$> listContainers RunningContainers)
- ( liftIO cleanup `after` ensureProperty
+ ( liftIO cleanup `after` ensureProperty
(property desc $ liftIO $ toResult <$> stopContainer cid)
, return NoChange
)
@@ -638,7 +638,7 @@ data ContainerFilter = RunningContainers | AllContainers
-- | Only lists propellor managed containers.
listContainers :: ContainerFilter -> IO [ContainerId]
-listContainers status =
+listContainers status =
mapMaybe toContainerId . concatMap (split ",")
. mapMaybe (lastMaybe . words) . lines
<$> readProcess dockercmd ps
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index cb0f0b64..ec814c37 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -51,9 +51,9 @@ toIpTable r = map Param $
toIpTableArg :: Rules -> [String]
toIpTableArg Everything = []
toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
-toIpTableArg (DPort (Port port)) = ["--dport", show port]
-toIpTableArg (DPortRange (Port f, Port t)) =
- ["--dport", show f ++ ":" ++ show t]
+toIpTableArg (DPort port) = ["--dport", fromPort port]
+toIpTableArg (DPortRange (portf, portt)) =
+ ["--dport", fromPort portf ++ ":" ++ fromPort portt]
toIpTableArg (InIFace iface) = ["-i", iface]
toIpTableArg (OutIFace iface) = ["-o", iface]
toIpTableArg (Ctstate states) =
@@ -167,7 +167,7 @@ data Rules
-- ^There is actually some order dependency between proto and port so this should be a specific
-- data type with proto + ports
| DPort Port
- | DPortRange (Port,Port)
+ | DPortRange (Port, Port)
| InIFace Network.Interface
| OutIFace Network.Interface
| Ctstate [ ConnectionState ]
diff --git a/src/Propellor/Property/Munin.hs b/src/Propellor/Property/Munin.hs
index 43112a6c..2464985a 100644
--- a/src/Propellor/Property/Munin.hs
+++ b/src/Propellor/Property/Munin.hs
@@ -47,10 +47,9 @@ hostListFragment' hs os = concatMap muninHost hs
muninHost :: Host -> [String]
muninHost h = [ "[" ++ (hostName h) ++ "]"
, " address " ++ maybe (hostName h) (fromIPAddr . fst) (hOverride h)
- ] ++ (maybe [] (\x -> [" port " ++ (show $ fromPort $ snd x)]) (hOverride h)) ++ [""]
+ ] ++ (maybe [] (\x -> [" port " ++ (fromPort $ snd x)]) (hOverride h)) ++ [""]
hOverride :: Host -> Maybe (IPAddr, Port)
hOverride h = lookup (hostName h) os
- fromPort (Port p) = p
-- | Create the host list fragment for master config.
hostListFragment :: [Host] -> [String]
diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs
index bafca041..0f73bfb6 100644
--- a/src/Propellor/Property/OpenId.hs
+++ b/src/Propellor/Property/OpenId.hs
@@ -28,21 +28,21 @@ providerFor users hn mp = propertyList desc $ props
where
baseurl = hn ++ case mp of
Nothing -> ""
- Just (Port p) -> ':' : show p
+ Just p -> ':' : fromPort p
url = "http://"++baseurl++"/simpleid"
desc = "openid provider " ++ url
setbaseurl l
- | "SIMPLEID_BASE_URL" `isInfixOf` l =
+ | "SIMPLEID_BASE_URL" `isInfixOf` l =
"define('SIMPLEID_BASE_URL', '"++url++"');"
| otherwise = l
-
+
apacheconfigured = case mp of
Nothing -> toProp $
Apache.virtualHost hn (Port 80) "/var/www/html"
Just p -> propertyList desc $ props
& Apache.listenPorts [p]
& Apache.virtualHost hn p "/var/www/html"
-
+
-- the identities directory controls access, so open up
-- file mode
identfile (User u) = File.hasPrivContentExposed
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 5a08fb1e..0ad2186e 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -127,7 +127,7 @@ journald = "systemd-journald"
-- | Enables persistent storage of the journal.
persistentJournal :: Property NoInfo
-persistentJournal = check (not <$> doesDirectoryExist dir) $
+persistentJournal = check (not <$> doesDirectoryExist dir) $
combineProperties "persistent systemd journal"
[ cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
`assume` MadeChange
@@ -145,7 +145,7 @@ type Option = String
-- Does not ensure that the relevant daemon notices the change immediately.
--
-- This assumes that there is only one [Header] per file, which is
--- currently the case for files like journald.conf and system.conf.
+-- currently the case for files like journald.conf and system.conf.
-- And it assumes the file already exists with
-- the right [Header], so new lines can just be appended to the end.
configured :: FilePath -> Option -> String -> Property NoInfo
@@ -232,7 +232,7 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
-- Use nsenter to enter container and and run propellor to
-- finish provisioning.
- containerprovisioned =
+ containerprovisioned =
Chroot.propellChroot chroot (enterContainerProcess c) False
<!>
doNothing
@@ -261,7 +261,7 @@ nspawnService (Container name _ _) cfg = setup <!> teardown
, "--machine=%i"
] ++ nspawnServiceParams cfg
| otherwise = l
-
+
goodservicefile = (==)
<$> servicefilecontent
<*> catchDefaultIO "" (readFile servicefile)
@@ -368,7 +368,7 @@ class Publishable a where
toPublish :: a -> String
instance Publishable Port where
- toPublish (Port n) = show n
+ toPublish port = fromPort port
instance Publishable (Bound Port) where
toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v)
@@ -380,7 +380,7 @@ instance Publishable (Proto, Bound Port) where
toPublish (UDP, fp) = "udp:" ++ toPublish fp
-- | Publish a port from the container to the host.
---
+--
-- This feature was first added in systemd version 220.
--
-- This property is only needed (and will only work) if the container
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index c302d11d..0abc76ac 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -13,6 +13,7 @@ module Propellor.Types.OS (
Group(..),
userGroup,
Port(..),
+ fromPort,
) where
import Network.BSD (HostName)
@@ -53,3 +54,6 @@ userGroup (User u) = Group u
newtype Port = Port Int
deriving (Eq, Show)
+
+fromPort :: Port -> String
+fromPort (Port p) = show p