propellor 4.6.0 → 4.6.1

raw patch · 8 files changed

+140/−71 lines, 8 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +10/−0
• debian/changelog +10/−0
• joeyconfig.hs +7/−37
• propellor.cabal +1/−1
• src/Propellor/Property/DiskImage.hs +1/−1
• src/Propellor/Property/Network.hs +38/−21
• src/Propellor/Property/SiteSpecific/JoeySites.hs +71/−10
• src/Propellor/Types/Info.hs +2/−1

@@ -1,3 +1,13 @@+propellor (4.6.1) unstable; urgency=medium++  * Added Network.dhcp' and Network.static', which allow specifying+    additional options for interfaces files.+  * Fix build failure on ghc-8.2.1+    Thanks, Sergei Trofimovich.+  * DiskImage: Fix strictness bug in .parttable read/write sequence.++ -- Joey Hess <id@joeyh.name>  Thu, 27 Jul 2017 09:17:32 -0400+ propellor (4.6.0) unstable; urgency=medium    * Add Typeable instance to Bootstrapper, fixing build with old versions

@@ -1,3 +1,13 @@+propellor (4.6.1) unstable; urgency=medium++  * Added Network.dhcp' and Network.static', which allow specifying+    additional options for interfaces files.+  * Fix build failure on ghc-8.2.1+    Thanks, Sergei Trofimovich.+  * DiskImage: Fix strictness bug in .parttable read/write sequence.++ -- Joey Hess <id@joeyh.name>  Thu, 27 Jul 2017 09:17:32 -0400+ propellor (4.6.0) unstable; urgency=medium    * Add Typeable instance to Bootstrapper, fixing build with old versions

@@ -201,53 +201,23 @@ 	-- No hardware clock 	& Apt.serviceInstalledRunning "ntp" -	-- Home router-	& Network.static "eth0" (IPv4 "192.168.1.42")-		(Just (Network.Gateway (IPv4 "192.168.1.1")))-		`requires` Network.cleanInterfacesFile-	& Network.static "wlan0" (IPv4 "10.1.1.1") Nothing-		`requires` Network.cleanInterfacesFile-	& Apt.serviceInstalledRunning "hostapd"-		`requires` File.hasContent "/etc/hostapd/hostapd.conf"-			[ "interface=wlan0"-			, "ssid=house"-			, "hw_mode=g"-			, "channel=8"-			]-		`requires` File.dirExists "/lib/hostapd"-	& Apt.serviceInstalledRunning "dnsmasq"-		`requires` File.hasContent "/etc/dnsmasq.conf"-			[ "domain-needed"-			, "bogus-priv"-			, "interface=wlan0"-			, "domain=kitenet.net"-			, "dhcp-range=10.1.1.100,10.1.1.150,24h"-			, "no-hosts"-			, "address=/honeybee.kitenet.net/10.1.1.1"-			]-		`requires` File.hasContent "/etc/resolv.conf"-			[ "domain kitenet.net"-			, "search kitenet.net"-			, "nameserver 8.8.8.8"-			, "nameserver 8.8.4.4"-			]-	& JoeySites.ipmasq "eth0" "wlan0"-	& Apt.installed ["ppp", "mtr", "iftop", "git-annex", "screen"]+	& JoeySites.homeRouter+	& Apt.installed ["mtr-tiny", "iftop", "screen"] 	& Postfix.satellite -	-- Autobuild runs only on weekdays. 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer 		GitAnnexBuilder.armAutoBuilder-		Unstable ARMEL Nothing weekends "10h")-	-- Autobuild runs only on weekends.-	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer+		Unstable ARMEL Nothing (Cron.Times "15 10 * * *") "10h")+	-- Disabled because it does not work, and the old systemd+	-- in the container uses a ton of CPU+	! Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer 		GitAnnexBuilder.stackAutoBuilder 		(Stable "jessie") ARMEL (Just "ancient") weekdays "10h") 	-- In case compiler needs more than available ram 	& Apt.serviceInstalledRunning "swapspace"   where 	weekdays = Cron.Times "15 10 * * 2-5"-	weekends = Cron.Times "15 10 * * 6-7"+	-- weekends = Cron.Times "15 10 * * 6-7"  -- This is not a complete description of kite, since it's a -- multiuser system with eg, user passwords that are not deployed

@@ -1,5 +1,5 @@ Name: propellor-Version: 4.6.0+Version: 4.6.1 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>

@@ -284,7 +284,7 @@ 	desc = "disk image exists " ++ img 	parttablefile = img ++ ".parttable" 	setup = property' desc $ \w -> do-		oldparttable <- liftIO $ catchDefaultIO "" $ readFile parttablefile+		oldparttable <- liftIO $ catchDefaultIO "" $ readFileStrict parttablefile 		res <- ensureProperty w $ imageExists img (partTableSize parttable) 		if res == NoChange && oldparttable == show parttable 			then return NoChange

@@ -7,6 +7,9 @@  type Interface = String +-- | Options to put in a stanza of an ifupdown interfaces file.+type InterfaceOptions = [(String, String)]+ ifUp :: Interface -> Property DebianLike ifUp iface = tightenTargets $ cmdProperty "ifup" [iface] 	`assume` MadeChange@@ -19,44 +22,51 @@ -- -- No interfaces are brought up or down by this property. cleanInterfacesFile :: Property DebianLike-cleanInterfacesFile = tightenTargets $ hasContent interfacesFile-	[ "# Deployed by propellor, do not edit."-	, ""-	, "source-directory interfaces.d"+cleanInterfacesFile = interfaceFileContains interfacesFile+	[ "source-directory interfaces.d" 	, "" 	, "# The loopback network interface" 	, "auto lo" 	, "iface lo inet loopback" 	]+	[] 	`describe` ("clean " ++ interfacesFile)  -- | Configures an interface to get its address via dhcp. dhcp :: Interface -> Property DebianLike-dhcp iface = tightenTargets $ hasContent (interfaceDFile iface)+dhcp iface = dhcp' iface mempty++dhcp' :: Interface -> InterfaceOptions -> Property DebianLike+dhcp' iface options = interfaceFileContains (interfaceDFile iface) 	[ "auto " ++ iface 	, "iface " ++ iface ++ " inet dhcp"-	]+	] options 	`describe` ("dhcp " ++ iface) 	`requires` interfacesDEnabled  newtype Gateway = Gateway IPAddr  -- | Configures an interface with a static address and gateway.-static :: Interface -> IPAddr -> Maybe Gateway-> Property DebianLike-static iface addr gateway = -	tightenTargets $ hasContent (interfaceDFile iface) ls+static :: Interface -> IPAddr -> Maybe Gateway -> Property DebianLike+static iface addr gateway = static' iface addr gateway mempty++static' :: Interface -> IPAddr -> Maybe Gateway -> InterfaceOptions -> Property DebianLike+static' iface addr gateway options =+	interfaceFileContains (interfaceDFile iface) headerlines options' 	`describe` ("static IP address for " ++ iface) 	`requires` interfacesDEnabled   where-	ls = catMaybes-		[ Just $ "auto " ++ iface-		, Just $ "iface " ++ iface ++ " " ++ inet ++ " static"-		, Just $ "\taddress " ++ val addr+	headerlines =+		[ "auto " ++ iface+		, "iface " ++ iface ++ " " ++ inet ++ " static"+		]+	options' = catMaybes+		[ Just $ ("address", val addr) 		, case gateway of 			Just (Gateway gaddr) -> -				Just $ "\tgateway " ++ val gaddr+				Just ("gateway", val gaddr) 			Nothing -> Nothing-		]+		] ++ options 	inet = case addr of 		IPv4 _ -> "inet" 		IPv6 _ -> "inet6"@@ -107,14 +117,14 @@  -- | 6to4 ipv6 connection, should work anywhere ipv6to4 :: Property DebianLike-ipv6to4 = tightenTargets $ hasContent (interfaceDFile "sit0")-	[ "# Deployed by propellor, do not edit."+ipv6to4 = tightenTargets $ interfaceFileContains (interfaceDFile "sit0")+	[ "auto sit0" 	, "iface sit0 inet6 static"-	, "\taddress 2002:5044:5531::1"-	, "\tnetmask 64"-	, "\tgateway ::192.88.99.1"-	, "auto sit0" 	]+	[ ("address", "2002:5044:5531::1")+	, ("netmask", "64")+	, ("gateway", "::192.88.99.1")+	] 	`describe` "ipv6to4" 	`requires` interfacesDEnabled 	`onChange` ifUp "sit0"@@ -137,3 +147,10 @@ interfacesDEnabled = tightenTargets $ 	containsLine interfacesFile "source-directory interfaces.d" 		`describe` "interfaces.d directory enabled"++interfaceFileContains :: FilePath -> [String] -> InterfaceOptions -> Property DebianLike+interfaceFileContains f headerlines options = tightenTargets $ hasContent f $+	warning : headerlines ++ map fmt options+  where+	fmt (k, v) = "\t" ++ k ++ " " ++ v+	warning = "# Deployed by propellor, do not edit."

@@ -19,6 +19,7 @@ import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.Postfix as Postfix import qualified Propellor.Property.Systemd as Systemd+import qualified Propellor.Property.Network as Network import qualified Propellor.Property.Fail2Ban as Fail2Ban import qualified Propellor.Property.LetsEncrypt as LetsEncrypt import Utility.FileMode@@ -930,21 +931,81 @@ 	& "/etc/systemd/logind.conf" `ConfFile.containsIniSetting` 		("Login", "LidSwitchIgnoreInhibited", "no") --- | Enable IP masqerading, from the intif to the extif.-ipmasq :: String -> String -> Property DebianLike-ipmasq extif intif = script `File.hasContent`+-- My home router, running hostapd and dnsmasq for wlan0,+-- with eth0 connected to a satellite modem, and a fallback ppp connection.+homeRouter :: Property (HasInfo + DebianLike)+homeRouter = propertyList "home router" $ props+	& Network.static "wlan0" (IPv4 "10.1.1.1") Nothing+		`requires` Network.cleanInterfacesFile+	& Apt.serviceInstalledRunning "hostapd"+		`requires` File.hasContent "/etc/hostapd/hostapd.conf"+			[ "interface=wlan0"+			, "ssid=house"+			, "hw_mode=g"+			, "channel=8"+			]+		`requires` File.dirExists "/lib/hostapd"+	& Apt.serviceInstalledRunning "dnsmasq"+		`requires` File.hasContent "/etc/dnsmasq.conf"+			[ "domain-needed"+			, "bogus-priv"+			, "interface=wlan0"+			, "domain=kitenet.net"+			, "dhcp-range=10.1.1.100,10.1.1.150,24h"+			, "no-hosts"+			, "address=/honeybee.kitenet.net/10.1.1.1"+			]+		`requires` File.hasContent "/etc/resolv.conf"+			[ "domain kitenet.net"+			, "search kitenet.net"+			, "nameserver 8.8.8.8"+			, "nameserver 8.8.4.4"+			]+	& ipmasq "wlan0"+	& Apt.serviceInstalledRunning "netplug"+	& Network.static' "eth0" (IPv4 "192.168.1.42")+		(Just (Network.Gateway (IPv4 "192.168.1.1")))+		-- When satellite is down, fall back to dialup+		[ ("pre-up", "poff -a || true")+		, ("post-down", "pon")+		]+		`requires` Network.cleanInterfacesFile+	& Apt.installed ["ppp"]+		`before` File.hasContent "/etc/ppp/peers/provider"+			[ "user \"joeyh@arczip.com\""+			, "connect \"/usr/sbin/chat -v -f /etc/chatscripts/pap -T 9734111\""+			, "/dev/ttyACM0"+			, "115200"+			, "noipdefault"+			, "defaultroute"+			, "persist"+			, "noauth"+			]+		`before` File.hasPrivContent "/etc/ppp/pap-secrets" (Context "joeyh@arczip.com")++-- | Enable IP masqerading, on whatever other interfaces come up than the+-- provided intif.+ipmasq :: String -> Property DebianLike+ipmasq intif = File.hasContent ifupscript 	[ "#!/bin/sh"-	, "EXTIF=" ++ extif 	, "INTIF=" ++ intif-	, "if [ \"$IFACE\" != $EXTIF; then"+	, "if [ \"$IFACE\" = $INTIF ] || [ \"$IFACE\" = lo ]; then" 	, "exit 0" 	, "fi"-	, "iptables -A FORWARD -i $EXTIF -o $INTIF -m state --state ESTABLISHED,RELATED -j ACCEPT"-	, "iptables -A FORWARD -i $INTIF -o $EXTIF -j ACCEPT"-	, "iptables -t nat -A POSTROUTING -o $EXTIF -j MASQUERADE"+	, "iptables -F"+	, "iptables -A FORWARD -i $IFACE -o $INTIF -m state --state ESTABLISHED,RELATED -j ACCEPT"+	, "iptables -A FORWARD -i $INTIF -o $IFACE -j ACCEPT"+	, "iptables -t nat -A POSTROUTING -o $IFACE -j MASQUERADE" 	, "echo 1 > /proc/sys/net/ipv4/ip_forward" 	]+	`before` scriptmode ifupscript+	`before` File.hasContent pppupscript+		[ "#!/bin/sh"+		, "IFACE=$PPP_IFACE " ++ ifupscript+		]+	`before` scriptmode pppupscript 	`requires` Apt.installed ["iptables"]-	`before` (script `File.mode` combineModes (readModes ++ executeModes))   where-	script = "/etc/network/if-up.d/ipmasq"+	ifupscript = "/etc/network/if-up.d/ipmasq"+	pppupscript = "/etc/ppp/ip-up.d/ipmasq"+	scriptmode f = f `File.mode` combineModes (readModes ++ executeModes)

@@ -17,6 +17,7 @@ import Data.Dynamic import Data.Maybe import Data.Monoid+import qualified Data.Typeable as T import Prelude  -- | Information about a Host, which can be provided by its properties.@@ -35,7 +36,7 @@ -- Extracts the value from an InfoEntry but only when -- it's of the requested type. extractInfoEntry :: Typeable v => InfoEntry -> Maybe v-extractInfoEntry (InfoEntry v) = cast v+extractInfoEntry (InfoEntry v) = T.cast v  -- | Values stored in Info must be members of this class. --