summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2016-03-02 15:40:32 -0400
committerJoey Hess2016-03-02 15:40:32 -0400
commit397301d9a520b719c112b6634370ed66ace09a61 (patch)
tree0d226814cc8f5ca66b22e73794ee1da840f5b71c
parentfaba0482eb71df06ac0ddb1e134289b5b3d45ec0 (diff)
parentf91827512647d7a1f15ddeece0c55d2852e400e4 (diff)
Merge branch 'joeyconfig'
-rw-r--r--config-joey.hs2
-rw-r--r--debian/changelog11
-rw-r--r--propellor.cabal2
-rw-r--r--src/Propellor/CmdLine.hs52
-rw-r--r--src/Propellor/Property/Firewall.hs169
5 files changed, 153 insertions, 83 deletions
diff --git a/config-joey.hs b/config-joey.hs
index 466a7f8c..24eff835 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -87,7 +87,7 @@ darkstar = host "darkstar.kitenet.net"
& JoeySites.alarmClock "*-*-* 7:30" (User "joey")
"/usr/bin/timeout 45m /home/joey/bin/goodmorning"
- & imageBuilt "/tmp/img" c MSDOS (grubBooted PC)
+ ! imageBuilt "/tmp/img" c MSDOS (grubBooted PC)
[ partition EXT2 `mountedAt` "/boot"
`setFlag` BootFlag
, partition EXT4 `mountedAt` "/"
diff --git a/debian/changelog b/debian/changelog
index c5b27741..1dabeaa0 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,17 @@
-propellor (2.16.1) UNRELEASED; urgency=medium
+propellor (2.17.0) UNRELEASED; urgency=medium
* Apt.upgrade: Run dpkg --configure -a first, to recover from
interrupted upgrades.
* Apt: Add safeupgrade.
+ * Avoid repeated re-building on systems such as FreeBSD where building
+ re-links the binary even when there are no changes.
+ * Firewall: Renamed TargetNat, TargetMangle, ... to
+ ChainNat, ChainMangle, ... (API change)
+ Thanks, Félix Sipma.
+ * Firewall: Separated Table and Target (API change)
+ Thanks, Félix Sipma.
+ * Firewall: add TCPFlag, Frequency, TCPSyn, ICMPTypeMatch
+ Thanks, Félix Sipma.
-- Joey Hess <id@joeyh.name> Mon, 29 Feb 2016 17:58:08 -0400
diff --git a/propellor.cabal b/propellor.cabal
index 4d8e7f26..3518a7ee 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
Name: propellor
-Version: 2.16.0
+Version: 2.17.0
Cabal-Version: >= 1.8
License: BSD3
Maintainer: Joey Hess <id@joeyh.name>
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 6d9db8bf..a0ae9cb5 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -88,6 +88,8 @@ processCmdLine = go =<< getArgs
Just cmdline -> return $ mk cmdline
Nothing -> errorMessage $ "serialization failure (" ++ s ++ ")"
+data CanRebuild = CanRebuild | NoRebuild
+
-- | Runs propellor on hosts, as controlled by command-line options.
defaultMain :: [Host] -> IO ()
defaultMain hostlist = withConcurrentOutput $ do
@@ -95,10 +97,9 @@ defaultMain hostlist = withConcurrentOutput $ do
checkDebugMode
cmdline <- processCmdLine
debug ["command line: ", show cmdline]
- go True cmdline
+ go CanRebuild cmdline
where
- go _ (Serialized cmdline) = go True cmdline
- go _ (Continue cmdline) = go False cmdline
+ go cr (Serialized cmdline) = go cr cmdline
go _ Check = return ()
go _ (Set field context) = setPrivData field context
go _ (Unset field context) = unsetPrivData field context
@@ -112,26 +113,32 @@ defaultMain hostlist = withConcurrentOutput $ do
go _ (DockerChain hn cid) = Docker.chain hostlist hn cid
go _ (DockerInit hn) = Docker.init hn
go _ (GitPush fin fout) = gitPushHelper fin fout
- go _ (Relay h) = forceConsole >> updateFirst (Update (Just h)) (update (Just h))
+ go cr (Relay h) = forceConsole >> updateFirst cr (Update (Just h)) (update (Just h))
go _ (Update Nothing) = forceConsole >> fetchFirst (onlyprocess (update Nothing))
go _ (Update (Just h)) = update (Just h)
go _ Merge = mergeSpin
- go True cmdline@(Spin _ _) = buildFirst cmdline $ go False cmdline
- go True cmdline = updateFirst cmdline $ go False cmdline
- go False (Spin hs mrelay) = do
+ go cr cmdline@(Spin hs mrelay) = buildFirst cr cmdline $ do
unless (isJust mrelay) commitSpin
forM_ hs $ \hn -> withhost hn $ spin mrelay hn
- go False cmdline@(SimpleRun hn) = do
- forceConsole
- buildFirst cmdline $ go False (Run hn)
- go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
- ( onlyprocess $ withhost hn mainProperties
- , go True (Spin [hn] Nothing)
- )
+ go cr (Run hn) = fetchFirst $
+ ifM ((==) 0 <$> getRealUserID)
+ ( runhost hn
+ , go cr (Spin [hn] Nothing)
+ )
+ go _ (SimpleRun hn) = runhost hn
+ go cr (Continue cmdline@(SimpleRun hn)) =
+ -- --continue SimpleRun is used by --spin,
+ -- and unlike all other uses of --continue, this legacy one
+ -- wants a build first
+ forceConsole >> fetchFirst (buildFirst cr cmdline (runhost hn))
+ -- When continuing after a rebuild, don't want to rebuild again.
+ go _ (Continue cmdline) = go NoRebuild cmdline
withhost :: HostName -> (Host -> IO ()) -> IO ()
withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
+ runhost hn = onlyprocess $ withhost hn mainProperties
+
onlyprocess = onlyProcess (localdir </> ".lock")
unknownhost :: HostName -> [Host] -> IO a
@@ -142,8 +149,8 @@ unknownhost h hosts = errorMessage $ unlines
, "Known hosts: " ++ unwords (map hostName hosts)
]
-buildFirst :: CmdLine -> IO () -> IO ()
-buildFirst cmdline next = do
+buildFirst :: CanRebuild -> CmdLine -> IO () -> IO ()
+buildFirst CanRebuild cmdline next = do
oldtime <- getmtime
buildPropellor
newtime <- getmtime
@@ -155,6 +162,7 @@ buildFirst cmdline next = do
]
where
getmtime = catchMaybeIO $ getModificationTime "propellor"
+buildFirst NoRebuild _ next = next
fetchFirst :: IO () -> IO ()
fetchFirst next = do
@@ -162,11 +170,14 @@ fetchFirst next = do
void fetchOrigin
next
-updateFirst :: CmdLine -> IO () -> IO ()
-updateFirst cmdline next = ifM hasOrigin (updateFirst' cmdline next, next)
+updateFirst :: CanRebuild -> CmdLine -> IO () -> IO ()
+updateFirst canrebuild cmdline next = ifM hasOrigin
+ ( updateFirst' canrebuild cmdline next
+ , next
+ )
-updateFirst' :: CmdLine -> IO () -> IO ()
-updateFirst' cmdline next = ifM fetchOrigin
+updateFirst' :: CanRebuild -> CmdLine -> IO () -> IO ()
+updateFirst' CanRebuild cmdline next = ifM fetchOrigin
( do
buildPropellor
void $ boolSystem "./propellor"
@@ -175,6 +186,7 @@ updateFirst' cmdline next = ifM fetchOrigin
]
, next
)
+updateFirst' NoRebuild _ next = next
-- Gets the fully qualified domain name, given a string that might be
-- a short name to look up in the DNS.
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index eefc8342..c4d2ee1b 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -7,14 +7,12 @@ module Propellor.Property.Firewall (
installed,
Chain(..),
Table(..),
- TargetFilter(..),
- TargetNat(..),
- TargetMangle(..),
- TargetRaw(..),
- TargetSecurity(..),
+ Target(..),
Proto(..),
Rules(..),
ConnectionState(..),
+ ICMPTypeMatch(..),
+ Frequency(..),
IPWithMask(..),
fromIPWithMask
) where
@@ -30,10 +28,10 @@ import qualified Propellor.Property.Network as Network
installed :: Property NoInfo
installed = Apt.installed ["iptables"]
-rule :: Chain -> Table -> Rules -> Property NoInfo
-rule c t rs = property ("firewall rule: " <> show r) addIpTable
+rule :: Chain -> Table -> Target -> Rules -> Property NoInfo
+rule c tb tg rs = property ("firewall rule: " <> show r) addIpTable
where
- r = Rule c t rs
+ r = Rule c tb tg rs
addIpTable = liftIO $ do
let args = toIpTable r
exist <- boolSystem "iptables" (chk args)
@@ -45,8 +43,9 @@ rule c t rs = property ("firewall rule: " <> show r) addIpTable
toIpTable :: Rule -> [CommandParam]
toIpTable r = map Param $
- show (ruleChain r) :
- toIpTableArg (ruleRules r) ++ toIpTableTable (ruleTable r)
+ fromChain (ruleChain r) :
+ toIpTableArg (ruleRules r) ++
+ ["-t", fromTable (ruleTable r), "-j", fromTarget (ruleTarget r)]
toIpTableArg :: Rules -> [String]
toIpTableArg Everything = []
@@ -61,6 +60,24 @@ toIpTableArg (Ctstate states) =
, "conntrack"
, "--ctstate", intercalate "," (map show states)
]
+toIpTableArg (ICMPType i) =
+ [ "-m"
+ , "icmp"
+ , "--icmp-type", fromICMPTypeMatch i
+ ]
+toIpTableArg (RateLimit f) =
+ [ "-m"
+ , "limit"
+ , "--limit", fromFrequency f
+ ]
+toIpTableArg (TCPFlags m c) =
+ [ "-m"
+ , "tcp"
+ , "--tcp-flags"
+ , intercalate "," (map show m)
+ , intercalate "," (map show c)
+ ]
+toIpTableArg TCPSyn = ["--syn"]
toIpTableArg (Source ipwm) =
[ "-s"
, intercalate "," (map fromIPWithMask ipwm)
@@ -80,78 +97,86 @@ fromIPWithMask (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm
fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m
data Rule = Rule
- { ruleChain :: Chain
- , ruleTable :: Table
- , ruleRules :: Rules
+ { ruleChain :: Chain
+ , ruleTable :: Table
+ , ruleTarget :: Target
+ , ruleRules :: Rules
} deriving (Eq, Show)
-data Table = Filter TargetFilter | Nat TargetNat | Mangle TargetMangle | Raw TargetRaw | Security TargetSecurity
+data Table = Filter | Nat | Mangle | Raw | Security
deriving (Eq, Show)
-toIpTableTable :: Table -> [String]
-toIpTableTable f = ["-t", table, "-j", target]
- where
- (table, target) = toIpTableTable' f
-
-toIpTableTable' :: Table -> (String, String)
-toIpTableTable' (Filter target) = ("filter", fromTarget target)
-toIpTableTable' (Nat target) = ("nat", fromTarget target)
-toIpTableTable' (Mangle target) = ("mangle", fromTarget target)
-toIpTableTable' (Raw target) = ("raw", fromTarget target)
-toIpTableTable' (Security target) = ("security", fromTarget target)
+fromTable :: Table -> String
+fromTable Filter = "filter"
+fromTable Nat = "nat"
+fromTable Mangle = "mangle"
+fromTable Raw = "raw"
+fromTable Security = "security"
-data Chain = INPUT | OUTPUT | FORWARD
+data Target = ACCEPT | REJECT | DROP | LOG | TargetCustom String
deriving (Eq, Show)
-data TargetFilter = ACCEPT | REJECT | DROP | LOG | FilterCustom String
+fromTarget :: Target -> String
+fromTarget ACCEPT = "ACCEPT"
+fromTarget REJECT = "REJECT"
+fromTarget DROP = "DROP"
+fromTarget LOG = "LOG"
+fromTarget (TargetCustom t) = t
+
+data Chain = ChainFilter | ChainNat | ChainMangle | ChainRaw | ChainSecurity
deriving (Eq, Show)
-class FromTarget a where
- fromTarget :: a -> String
+instance FromChain Chain where
+ fromChain = fromChain
+
+class FromChain a where
+ fromChain :: a -> String
+
+data ChainFilter = INPUT | OUTPUT | FORWARD | FilterCustom String
+ deriving (Eq, Show)
-instance FromTarget TargetFilter where
- fromTarget ACCEPT = "ACCEPT"
- fromTarget REJECT = "REJECT"
- fromTarget DROP = "DROP"
- fromTarget LOG = "LOG"
- fromTarget (FilterCustom f) = f
+instance FromChain ChainFilter where
+ fromChain INPUT = "INPUT"
+ fromChain OUTPUT = "OUTPUT"
+ fromChain FORWARD = "FORWARD"
+ fromChain (FilterCustom c) = c
-data TargetNat = NatPREROUTING | NatOUTPUT | NatPOSTROUTING | NatCustom String
+data ChainNat = NatPREROUTING | NatOUTPUT | NatPOSTROUTING | NatCustom String
deriving (Eq, Show)
-instance FromTarget TargetNat where
- fromTarget NatPREROUTING = "PREROUTING"
- fromTarget NatOUTPUT = "OUTPUT"
- fromTarget NatPOSTROUTING = "POSTROUTING"
- fromTarget (NatCustom f) = f
+instance FromChain ChainNat where
+ fromChain NatPREROUTING = "PREROUTING"
+ fromChain NatOUTPUT = "OUTPUT"
+ fromChain NatPOSTROUTING = "POSTROUTING"
+ fromChain (NatCustom f) = f
-data TargetMangle = ManglePREROUTING | MangleOUTPUT | MangleINPUT | MangleFORWARD | ManglePOSTROUTING | MangleCustom String
+data ChainMangle = ManglePREROUTING | MangleOUTPUT | MangleINPUT | MangleFORWARD | ManglePOSTROUTING | MangleCustom String
deriving (Eq, Show)
-instance FromTarget TargetMangle where
- fromTarget ManglePREROUTING = "PREROUTING"
- fromTarget MangleOUTPUT = "OUTPUT"
- fromTarget MangleINPUT = "INPUT"
- fromTarget MangleFORWARD = "FORWARD"
- fromTarget ManglePOSTROUTING = "POSTROUTING"
- fromTarget (MangleCustom f) = f
+instance FromChain ChainMangle where
+ fromChain ManglePREROUTING = "PREROUTING"
+ fromChain MangleOUTPUT = "OUTPUT"
+ fromChain MangleINPUT = "INPUT"
+ fromChain MangleFORWARD = "FORWARD"
+ fromChain ManglePOSTROUTING = "POSTROUTING"
+ fromChain (MangleCustom f) = f
-data TargetRaw = RawPREROUTING | RawOUTPUT | RawCustom String
+data ChainRaw = RawPREROUTING | RawOUTPUT | RawCustom String
deriving (Eq, Show)
-instance FromTarget TargetRaw where
- fromTarget RawPREROUTING = "PREROUTING"
- fromTarget RawOUTPUT = "OUTPUT"
- fromTarget (RawCustom f) = f
+instance FromChain ChainRaw where
+ fromChain RawPREROUTING = "PREROUTING"
+ fromChain RawOUTPUT = "OUTPUT"
+ fromChain (RawCustom f) = f
-data TargetSecurity = SecurityINPUT | SecurityOUTPUT | SecurityFORWARD | SecurityCustom String
+data ChainSecurity = SecurityINPUT | SecurityOUTPUT | SecurityFORWARD | SecurityCustom String
deriving (Eq, Show)
-instance FromTarget TargetSecurity where
- fromTarget SecurityINPUT = "INPUT"
- fromTarget SecurityOUTPUT = "OUTPUT"
- fromTarget SecurityFORWARD = "FORWARD"
- fromTarget (SecurityCustom f) = f
+instance FromChain ChainSecurity where
+ fromChain SecurityINPUT = "INPUT"
+ fromChain SecurityOUTPUT = "OUTPUT"
+ fromChain SecurityFORWARD = "FORWARD"
+ fromChain (SecurityCustom f) = f
data Proto = TCP | UDP | ICMP
deriving (Eq, Show)
@@ -159,6 +184,26 @@ data Proto = TCP | UDP | ICMP
data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID
deriving (Eq, Show)
+data ICMPTypeMatch = ICMPTypeName String | ICMPTypeCode Int
+ deriving (Eq, Show)
+
+fromICMPTypeMatch :: ICMPTypeMatch -> String
+fromICMPTypeMatch (ICMPTypeName t) = t
+fromICMPTypeMatch (ICMPTypeCode c) = show c
+
+data Frequency = NumBySecond Int
+ deriving (Eq, Show)
+
+fromFrequency :: Frequency -> String
+fromFrequency (NumBySecond n) = show n ++ "/second"
+
+type TCPFlagMask = [TCPFlag]
+
+type TCPFlagComp = [TCPFlag]
+
+data TCPFlag = SYN | ACK | FIN | RST | URG | PSH | ALL | NONE
+ deriving (Eq, Show)
+
data Rules
= Everything
| Proto Proto
@@ -169,6 +214,10 @@ data Rules
| InIFace Network.Interface
| OutIFace Network.Interface
| Ctstate [ ConnectionState ]
+ | ICMPType ICMPTypeMatch
+ | RateLimit Frequency
+ | TCPFlags TCPFlagMask TCPFlagComp
+ | TCPSyn
| Source [ IPWithMask ]
| Destination [ IPWithMask ]
| Rules :- Rules -- ^Combine two rules