Merge branch 'joeyconfig'

7 files changed, 112 insertions, 23 deletions

diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index eee1409c..fe99a3fd 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -255,7 +255,7 @@ isNewerThan x y = do
 --
 -- > myproperty = withOS "foo installed" $ \o -> case o of
 -- > 	(Just (System (Debian suite) arch)) -> ...
--- > 	(Just (System (FooBuntu release) arch)) -> ...
+-- > 	(Just (System (Buntish release) arch)) -> ...
 -- >	Nothing -> ...
 withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
 withOS desc a = property desc $ a =<< getOS
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 44d7036d..e0ff477d 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -90,7 +90,7 @@ data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig
 instance ChrootBootstrapper Debootstrapped where
 	buildchroot (Debootstrapped cf) system loc = case system of
 		(Just s@(System (Debian _) _)) -> Right $ debootstrap s
-		(Just s@(System (FooBuntu _) _)) -> Right $ debootstrap s
+		(Just s@(System (Buntish _) _)) -> Right $ debootstrap s
 		Nothing -> Left "Cannot debootstrap; `os` property not specified"
 	  where
 		debootstrap s = Debootstrap.built loc s cf
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 445c0629..6a566853 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -91,7 +91,7 @@ built' installprop target system@(System _ arch) config =
 	
 extractSuite :: System -> Maybe String
 extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
-extractSuite (System (FooBuntu r) _) = Just r
+extractSuite (System (Buntish r) _) = Just r
 
 -- | Ensures debootstrap is installed.
 --
@@ -108,12 +108,12 @@ installed = install <!> remove
 			)
 
 	installon (Just (System (Debian _) _)) = aptinstall
-	installon (Just (System (FooBuntu _) _)) = aptinstall
+	installon (Just (System (Buntish _) _)) = aptinstall
 	installon _ = sourceInstall
 
 	remove = withOS "debootstrap removed" $ ensureProperty . removefrom
 	removefrom (Just (System (Debian _) _)) = aptremove
-	removefrom (Just (System (FooBuntu _) _)) = aptremove
+	removefrom (Just (System (Buntish _) _)) = aptremove
 	removefrom _ = sourceRemove
 			
 	aptinstall = Apt.installed ["debootstrap"]
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index 20b44845..eefc8342 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -1,15 +1,22 @@
 -- | Maintainer: Arnaud Bailly <arnaud.oqube@gmail.com>
--- 
+--
 -- Properties for configuring firewall (iptables) rules
 
 module Propellor.Property.Firewall (
 	rule,
 	installed,
 	Chain(..),
-	Target(..),
+	Table(..),
+	TargetFilter(..),
+	TargetNat(..),
+	TargetMangle(..),
+	TargetRaw(..),
+	TargetSecurity(..),
 	Proto(..),
 	Rules(..),
-	ConnectionState(..)
+	ConnectionState(..),
+	IPWithMask(..),
+	fromIPWithMask
 ) where
 
 import Data.Monoid
@@ -23,7 +30,7 @@ import qualified Propellor.Property.Network as Network
 installed :: Property NoInfo
 installed = Apt.installed ["iptables"]
 
-rule :: Chain -> Target -> Rules -> Property NoInfo
+rule :: Chain -> Table -> Rules -> Property NoInfo
 rule c t rs = property ("firewall rule: " <> show r) addIpTable
   where
 	r = Rule c t rs
@@ -33,13 +40,13 @@ rule c t rs = property ("firewall rule: " <> show r) addIpTable
 		if exist
 			then return NoChange
 			else toResult <$> boolSystem "iptables" (add args)
-	add params = (Param "-A") : params
-	chk params = (Param "-C") : params
+	add params = Param "-A" : params
+	chk params = Param "-C" : params
 
 toIpTable :: Rule -> [CommandParam]
 toIpTable r =  map Param $
-	(show $ ruleChain r) :
-	(toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ]
+	show (ruleChain r) :
+	toIpTableArg (ruleRules r) ++ toIpTableTable (ruleTable r)
 
 toIpTableArg :: Rules -> [String]
 toIpTableArg Everything = []
@@ -47,26 +54,105 @@ 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 (IFace iface) = ["-i", iface]
+toIpTableArg (InIFace iface) = ["-i", iface]
+toIpTableArg (OutIFace iface) = ["-o", iface]
 toIpTableArg (Ctstate states) =
 	[ "-m"
 	, "conntrack"
-	, "--ctstate", concat $ intersperse "," (map show states)
+	, "--ctstate", intercalate "," (map show states)
+	]
+toIpTableArg (Source ipwm) =
+	[ "-s"
+	, intercalate "," (map fromIPWithMask ipwm)
+	]
+toIpTableArg (Destination ipwm) =
+	[ "-d"
+	, intercalate "," (map fromIPWithMask ipwm)
 	]
 toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
 
+data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int
+	deriving (Eq, Show)
+
+fromIPWithMask :: IPWithMask -> String
+fromIPWithMask (IPWithNoMask ip) = fromIPAddr ip
+fromIPWithMask (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm
+fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m
+
 data Rule = Rule
 	{ ruleChain :: Chain
-	, ruleTarget :: Target
+	, ruleTable :: Table
 	, ruleRules :: Rules
 	} deriving (Eq, Show)
 
+data Table = Filter TargetFilter | Nat TargetNat | Mangle TargetMangle | Raw TargetRaw | Security TargetSecurity
+	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)
+
 data Chain = INPUT | OUTPUT | FORWARD
 	deriving (Eq, Show)
 
-data Target = ACCEPT | REJECT | DROP | LOG
+data TargetFilter = ACCEPT | REJECT | DROP | LOG | FilterCustom String
+	deriving (Eq, Show)
+
+class FromTarget a where
+	fromTarget :: a -> String
+
+instance FromTarget TargetFilter where
+	fromTarget ACCEPT = "ACCEPT"
+	fromTarget REJECT = "REJECT"
+	fromTarget DROP = "DROP"
+	fromTarget LOG = "LOG"
+	fromTarget (FilterCustom f) = f
+
+data TargetNat = 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
+
+data TargetMangle = 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
+
+data TargetRaw = RawPREROUTING | RawOUTPUT | RawCustom String
+	deriving (Eq, Show)
+
+instance FromTarget TargetRaw where
+	fromTarget RawPREROUTING = "PREROUTING"
+	fromTarget RawOUTPUT = "OUTPUT"
+	fromTarget (RawCustom f) = f
+
+data TargetSecurity = 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
+
 data Proto = TCP | UDP | ICMP
 	deriving (Eq, Show)
 
@@ -80,8 +166,11 @@ data Rules
 	-- data type with proto + ports
 	| DPort Port
 	| DPortRange (Port,Port)
-	| IFace Network.Interface
+	| InIFace Network.Interface
+	| OutIFace Network.Interface
 	| Ctstate [ ConnectionState ]
+	| Source [ IPWithMask ]
+	| Destination [ IPWithMask ]
 	| Rules :- Rules   -- ^Combine two rules
 	deriving (Eq, Show)
 
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 403b1df3..5678b818 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -85,7 +85,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 
 	osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of
 		(Just d@(System (Debian _) _)) -> debootstrap d
-		(Just u@(System (FooBuntu _) _)) -> debootstrap u
+		(Just u@(System (Buntish _) _)) -> debootstrap u
 		_ -> error "os is not declared to be Debian or *buntu"
 	
 	debootstrap targetos = ensureProperty $
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 9e1fb7af..c21f009f 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -417,6 +417,6 @@ unauthorizedKey user@(User u) l = property desc $ do
 
 modAuthorizedKey :: FilePath -> User -> Property NoInfo -> Propellor Result
 modAuthorizedKey f user p = ensureProperty $ p
-	`requires` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
-	`requires` File.ownerGroup f user (userGroup user)
-	`requires` File.ownerGroup (takeDirectory f) user (userGroup user)
+	`before` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
+	`before` File.ownerGroup f user (userGroup user)
+	`before` File.ownerGroup (takeDirectory f) user (userGroup user)
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index 6c2dd28e..c302d11d 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -24,7 +24,7 @@ data System = System Distribution Architecture
 
 data Distribution
 	= Debian DebianSuite
-	| FooBuntu Release -- ^ "*buntu" (The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>)
+	| Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>)
 	deriving (Show, Eq)
 
 -- | Debian has several rolling suites, and a number of stable releases,