Merge branch 'joeyconfig'

8 files changed, 62 insertions, 54 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..fa1f95d4 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) =
@@ -87,6 +87,10 @@ toIpTableArg (Destination ipwm) =
 	[ "-d"
 	, intercalate "," (map fromIPWithMask ipwm)
 	]
+toIpTableArg (NatDestination ip mport) =
+	[ "--to-destination"
+	, fromIPAddr ip ++ maybe "" (\p -> ":" ++ fromPort p) mport
+	]
 toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
 
 data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int
@@ -167,7 +171,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 ]
@@ -177,6 +181,7 @@ data Rules
 	| TCPSyn
 	| Source [ IPWithMask ]
 	| Destination [ IPWithMask ]
+	| NatDestination IPAddr (Maybe Port)
 	| Rules :- Rules   -- ^Combine two rules
 	deriving (Eq, Show)
 
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/Ssh.hs b/src/Propellor/Property/Ssh.hs
index b67c53dd..26cdbeb7 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -75,7 +75,7 @@ setSshdConfig setting val = File.fileProperty desc f sshdConfig
 		| s == cfgline = True
 		| (setting ++ " ") `isPrefixOf` s = False
 		| otherwise = True
-	f ls 
+	f ls
 		| cfgline `elem` ls = filter wantedline ls
 		| otherwise = filter wantedline ls ++ [cfgline]
 
@@ -94,7 +94,7 @@ passwordAuthentication = setSshdConfigBool "PasswordAuthentication"
 
 -- | Configure ssh to not allow password logins.
 --
--- To prevent lock-out, this is done only once root's 
+-- To prevent lock-out, this is done only once root's
 -- authorized_keys is in place.
 noPasswords :: Property NoInfo
 noPasswords = check (hasAuthorizedKeys (User "root")) $
@@ -114,10 +114,10 @@ dotFile f user = do
 -- ports it is configured to listen on.
 --
 -- Revert to prevent it listening on a particular port.
-listenPort :: Int -> RevertableProperty NoInfo
+listenPort :: Port -> RevertableProperty NoInfo
 listenPort port = enable <!> disable
   where
-	portline = "Port " ++ show port
+	portline = "Port " ++ fromPort port
 	enable = sshdConfig `File.containsLine` portline
 		`describe` ("ssh listening on " ++ portline)
 		`onChange` restarted
@@ -173,7 +173,7 @@ hostKeys ctx l = propertyList desc $ catMaybes $
 -- | Installs a single ssh host key of a particular type.
 --
 -- The public key is provided to this function;
--- the private key comes from the privdata; 
+-- the private key comes from the privdata;
 hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property HasInfo
 hostKey context keytype pub = combineProperties desc
 	[ hostPubKey keytype pub
@@ -210,7 +210,7 @@ hostPubKey t = pureInfoProperty "ssh pubkey known" . HostKeyInfo . M.singleton t
 getHostPubKey :: Propellor (M.Map SshKeyType PubKeyText)
 getHostPubKey = fromHostKeyInfo <$> askInfo
 
-newtype HostKeyInfo = HostKeyInfo 
+newtype HostKeyInfo = HostKeyInfo
 	{ fromHostKeyInfo :: M.Map SshKeyType PubKeyText }
 	deriving (Eq, Ord, Typeable, Show)
 
@@ -219,7 +219,7 @@ instance IsInfo HostKeyInfo where
 
 instance Monoid HostKeyInfo where
 	mempty = HostKeyInfo M.empty
-	mappend (HostKeyInfo old) (HostKeyInfo new) = 
+	mappend (HostKeyInfo old) (HostKeyInfo new) =
 		-- new first because union prefers values from the first
 		-- parameter when there is a duplicate key
 		HostKeyInfo (new `M.union` old)
@@ -240,12 +240,12 @@ instance IsInfo UserKeyInfo where
 
 instance Monoid UserKeyInfo where
 	mempty = UserKeyInfo M.empty
-	mappend (UserKeyInfo old) (UserKeyInfo new) = 
+	mappend (UserKeyInfo old) (UserKeyInfo new) =
 		UserKeyInfo (M.unionWith S.union old new)
 
 -- | Sets up a user with the specified public keys, and the corresponding
 -- private keys from the privdata.
--- 
+--
 -- The public keys are added to the Info, so other properties like
 -- `authorizedKeysFrom` can use them.
 userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property HasInfo
@@ -277,7 +277,7 @@ userKeyAt dest user@(User u) context (keytype, pubkeytext) =
 		, Just $ "(" ++ fromKeyType keytype ++ ")"
 		]
 	pubkey = property desc $ install File.hasContent ".pub" [pubkeytext]
-	privkey = withPrivData (SshPrivKey keytype u) context $ \getkey -> 
+	privkey = withPrivData (SshPrivKey keytype u) context $ \getkey ->
 		property desc $ getkey $
 			install File.hasContentProtected "" . privDataLines
 	install writer ext key = do
@@ -349,7 +349,7 @@ modKnownHost user f p = ensureProperty $ p
 --
 -- Any other lines in the authorized_keys file are preserved as-is.
 authorizedKeysFrom :: User -> (User, Host) -> Property NoInfo
-localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) = 
+localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) =
 	property desc (go =<< authorizedKeyLines remoteuser remotehost)
   where
 	remote = rn ++ "@" ++ hostName remotehost
@@ -372,9 +372,9 @@ localuser@(User ln) `unauthorizedKeysFrom` (remoteuser@(User rn), remotehost) =
 	go [] = return NoChange
 	go ls = ensureProperty $ combineProperties desc $
 		map (revert . authorizedKey localuser) ls
-	
+
 authorizedKeyLines :: User -> Host -> Propellor [File.Line]
-authorizedKeyLines remoteuser remotehost = 
+authorizedKeyLines remoteuser remotehost =
 	map snd <$> fromHost' remotehost (getUserPubKeys remoteuser)
 
 -- | Makes a user have authorized_keys from the PrivData
@@ -404,7 +404,7 @@ authorizedKey user@(User u) l = add <!> remove
 				`requires` File.dirExists (takeDirectory f)
 	remove = property (u ++ " lacks authorized_keys") $ do
 		f <- liftIO $ dotFile "authorized_keys" user
-		ifM (liftIO $ doesFileExist f) 
+		ifM (liftIO $ doesFileExist f)
 			( modAuthorizedKey f user $ f `File.lacksLine` l
 			, return NoChange
 			)
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