diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 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 diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -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 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 diff --git a/joeyconfig.hs b/joeyconfig.hs --- a/joeyconfig.hs +++ b/joeyconfig.hs @@ -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 diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 4.6.0 +Version: 4.6.1 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -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 diff --git a/src/Propellor/Property/Network.hs b/src/Propellor/Property/Network.hs --- a/src/Propellor/Property/Network.hs +++ b/src/Propellor/Property/Network.hs @@ -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." diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -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) diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs --- a/src/Propellor/Types/Info.hs +++ b/src/Propellor/Types/Info.hs @@ -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. --