From 85e58f49ca676a3cfb34c6bfb27bb5d0b39e83f4 Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Mon, 7 Mar 2016 14:29:07 +0100 Subject: add fromPort function (cherry picked from commit c3a23f89092d1ef8367c37ab8993ea7031124f4b) --- src/Propellor/Property/Apache.hs | 22 +++++++++++----------- src/Propellor/Property/Docker.hs | 26 +++++++++++++------------- src/Propellor/Property/Firewall.hs | 8 ++++---- src/Propellor/Property/Munin.hs | 3 +-- src/Propellor/Property/OpenId.hs | 8 ++++---- src/Propellor/Property/Systemd.hs | 12 ++++++------ 6 files changed, 39 insertions(+), 40 deletions(-) (limited to 'src/Propellor/Property') 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 $ - [ "" - , "ServerName "++domain++":"++show p +virtualHost' domain port docroot addedcfg = siteEnabled domain $ + [ "" + , "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 = - [ "" - , "ServerName "++domain++":"++show p + vhost p ls = + [ "" + , "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 -- cgit v1.2.3 From 476e242b0fc242e36f00d3c182c557e83e92c300 Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Mon, 7 Mar 2016 14:32:23 +0100 Subject: Ssh: change type of listenPort from Int to Port (API change) (cherry picked from commit 0207c5ab585f41877c1b9f9674a25941cffd2ac7) --- config-joey.hs | 44 +++++++++++++++++++++---------------------- src/Propellor/Property/Ssh.hs | 28 +++++++++++++-------------- 2 files changed, 36 insertions(+), 36 deletions(-) (limited to 'src/Propellor/Property') diff --git a/config-joey.hs b/config-joey.hs index 12846d36..bab8f466 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -38,7 +38,7 @@ import qualified Propellor.Property.SiteSpecific.Branchable as Branchable import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites import Propellor.Property.DiskImage -main :: IO () -- _ ______`| ,-.__ +main :: IO () -- _ ______`| ,-.__ main = defaultMain hosts -- / \___-=O`/|O`/__| (____.' {- Propellor -- \ / | / ) _.-"-._ Deployed -} -- `/-==__ _/__|/__=-| ( \_ @@ -133,7 +133,7 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64" & File.notPresent "/var/www/index.html" & "/var/www/html/index.html" `File.hasContent` ["hello, world"] & alias "helloworld.kitenet.net" - + & Systemd.nspawned oldusenetShellBox & JoeySites.scrollBox @@ -150,7 +150,7 @@ mayfly = standardSystem "mayfly.kitenet.net" (Stable "jessie") "amd64" & Network.ipv6to4 & Systemd.persistentJournal & Journald.systemMaxUse "500MiB" - + & Tor.isRelay & Tor.named "kite3" & Tor.bandwidthRate (Tor.PerMonth "400 GB") @@ -172,11 +172,11 @@ oyster = standardSystem "oyster.kitenet.net" Unstable "amd64" & Tor.isRelay & Tor.named "kite2" & Tor.bandwidthRate (Tor.PerMonth "400 GB") - + -- Nothing is using http port 80, so listen on -- that port for ssh, for traveling on bad networks that -- block 22. - & Ssh.listenPort 80 + & Ssh.listenPort (Port 80) orca :: Host orca = standardSystem "orca.kitenet.net" Unstable "amd64" @@ -203,7 +203,7 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64" honeybee :: Host honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf" [ "Arm git-annex build box." ] - + -- I have to travel to get console access, so no automatic -- upgrades, and try to be robust. & "/etc/default/rcS" `File.containsLine` "FSCKFIX=yes" @@ -213,7 +213,7 @@ honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf" & Apt.installed ["linux-image-armmp"] & Network.dhcp "eth0" `requires` Network.cleanInterfacesFile & Postfix.satellite - + -- ipv6 used for remote access thru firewalls & Apt.serviceInstalledRunning "aiccu" & ipv6 "2001:4830:1600:187::2" @@ -291,12 +291,12 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64" & alias "pop.kitenet.net" & alias "mail.kitenet.net" & JoeySites.kiteMailServer - + & JoeySites.kitenetHttps & JoeySites.legacyWebSites & File.ownerGroup "/srv/web" (User "joey") (Group "joey") & Apt.installed ["analog"] - + & alias "git.kitenet.net" & alias "git.joeyh.name" & JoeySites.gitServer hosts @@ -312,7 +312,7 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64" , "User = bitlbee" , "AuthMode = Registered" , "[defaults]" - ] + ] `onChange` Service.restarted "bitlbee" & "/etc/default/bitlbee" `File.containsLine` "BITLBEE_PORT=\"6767\"" `onChange` Service.restarted "bitlbee" @@ -325,10 +325,10 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64" -- Some users have zsh as their login shell. , "zsh" ] - + & alias "nntp.olduse.net" & JoeySites.oldUseNetServer hosts - + & alias "ns4.kitenet.net" & myDnsPrimary True "kitenet.net" [] & myDnsPrimary True "joeyh.name" [] @@ -370,7 +370,7 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64" & Systemd.persistentJournal & Ssh.userKeys (User "joey") hostContext [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC4wJuQEGno+nJvtE75IKL6JQ08sJHZ9Bzs9Dvu0zuxSEZE30MWK98/twNwCH9PVf2N9m4apfN7f9GHgHTUongfo8xnLAk4PuBSTV74YgKyOCvNYqANuKKa+76PsS/vFf/or3ct++uTEWsRyYD29cQndufwKA4rthAqHG+fifbLDC53AjcldI0zI1RckpPzT+AMazlnSBFMlpKvGD2uzSXALVRXa3vSqWkWd0z7qmIkpmpq0AAgbDLwrGBcUGV/h0rOa2s8zSeirA0tLmHNROl4cZsX0T/6VBGfBRkrHSxL67xJziATw4WPq6spYlxg84pC/5qJVr9SC5HosppbDqgj joey@elephant") - ] + ] & Apt.serviceInstalledRunning "swapspace" & alias "eubackup.kitenet.net" @@ -381,27 +381,27 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64" & alias "podcatcher.kitenet.net" & JoeySites.podcatcher - + & alias "znc.kitenet.net" & JoeySites.ircBouncer & alias "kgb.kitenet.net" & JoeySites.kgbServer - + & alias "mumble.kitenet.net" & JoeySites.mumbleServer hosts - + & alias "ns3.kitenet.net" & myDnsSecondary - + & Systemd.nspawned oldusenetShellBox & Systemd.nspawned ancientKitenet & Systemd.nspawned openidProvider `requires` Apt.serviceInstalledRunning "ntp" - + & JoeySites.scrollBox & alias "scroll.joeyh.name" & alias "eu.scroll.joeyh.name" - + -- For https port 443, shellinabox with ssh login to -- kitenet.net & alias "shell.kitenet.net" @@ -409,7 +409,7 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64" -- Nothing is using http port 80, so listen on -- that port for ssh, for traveling on bad networks that -- block 22. - & Ssh.listenPort 80 + & Ssh.listenPort (Port 80) beaver :: Host beaver = host "beaver.kitenet.net" @@ -429,7 +429,7 @@ pell = host "pell.branchable.com" & alias "branchable.com" & ipv4 "66.228.46.55" & ipv6 "2600:3c03::f03c:91ff:fedf:c0e5" - + -- All the websites I host at branchable that don't use -- branchable.com dns. & alias "olduse.net" @@ -596,7 +596,7 @@ monsters :: [Host] -- Systems I don't manage with propellor, monsters = -- but do want to track their public keys etc. [ host "usw-s002.rsync.net" & Ssh.hostPubKey SshEd25519 "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB7yTEBGfQYdwG/oeL+U9XPMIh/dW7XNs9T+M79YIOrd" - , host "github.com" + , host "github.com" & Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ==" , host "gitlab.com" & Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY=" 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 ) -- cgit v1.2.3 From c9dbae56a34775b6e4e49b24535a8e6bacb0e7ce Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Mon, 7 Mar 2016 14:41:19 +0100 Subject: Firewall: add NatDestination to Rules (cherry picked from commit df40046fd65bc07eced41adb73c7e227d2b54cd1) --- src/Propellor/Property/Firewall.hs | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index ec814c37..fa1f95d4 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -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 @@ -177,6 +181,7 @@ data Rules | TCPSyn | Source [ IPWithMask ] | Destination [ IPWithMask ] + | NatDestination IPAddr (Maybe Port) | Rules :- Rules -- ^Combine two rules deriving (Eq, Show) -- cgit v1.2.3