diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,22 @@ +propellor (5.10.1) unstable; urgency=medium + + [ Joey Hess ] + * Localdir.hasOriginUrl: Depend on Git.installed. + * Localdir.hasOriginUrl: Type changed from UnixLike to DebianLike + because Git.installed is not implemented for other unixes. + (API change) + * Changed the ChrootBootstrapper type class's buildchroot method + to take a Info parameter, instead of Maybe System. + (The System can be extracted from the Info.) + (API change) + + [ Sean Whitton ] + * Chroot.{de,}bootstrapped uses the chroot's configured apt proxy and + mirror, if these exist, when debootstrapping the chroot. + * Rename Sbuild.useHostProxy -> Chroot.useHostProxy. (API change) + + -- Joey Hess Fri, 15 Nov 2019 13:26:19 -0400 + propellor (5.9.1) unstable; urgency=medium * Apt: Debian has changed the name of the suite for testing security updates diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -26,7 +26,7 @@ and [Docker](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Docker.html), etc. -There is no special language as used in puppet, chef, ansible, etc.. just +There is no special language as used in puppet, ansible, etc.. just the full power of Haskell. Hopefully that power can be put to good use in making declarative properties that are powerful, nicely idempotent, and easy to adapt to a system's special needs! diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,22 @@ +propellor (5.10.1) unstable; urgency=medium + + [ Joey Hess ] + * Localdir.hasOriginUrl: Depend on Git.installed. + * Localdir.hasOriginUrl: Type changed from UnixLike to DebianLike + because Git.installed is not implemented for other unixes. + (API change) + * Changed the ChrootBootstrapper type class's buildchroot method + to take a Info parameter, instead of Maybe System. + (The System can be extracted from the Info.) + (API change) + + [ Sean Whitton ] + * Chroot.{de,}bootstrapped uses the chroot's configured apt proxy and + mirror, if these exist, when debootstrapping the chroot. + * Rename Sbuild.useHostProxy -> Chroot.useHostProxy. (API change) + + -- Joey Hess Fri, 15 Nov 2019 13:26:19 -0400 + propellor (5.9.1) unstable; urgency=medium * Apt: Debian has changed the name of the suite for testing security updates diff --git a/doc/README.mdwn b/doc/README.mdwn --- a/doc/README.mdwn +++ b/doc/README.mdwn @@ -26,7 +26,7 @@ and [Docker](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Docker.html), etc. -There is no special language as used in puppet, chef, ansible, etc.. just +There is no special language as used in puppet, ansible, etc.. just the full power of Haskell. Hopefully that power can be put to good use in making declarative properties that are powerful, nicely idempotent, and easy to adapt to a system's special needs! diff --git a/joeyconfig.hs b/joeyconfig.hs --- a/joeyconfig.hs +++ b/joeyconfig.hs @@ -32,6 +32,7 @@ import qualified Propellor.Property.Journald as Journald import qualified Propellor.Property.Fail2Ban as Fail2Ban import qualified Propellor.Property.Laptop as Laptop +import qualified Propellor.Property.LightDM as LightDM import qualified Propellor.Property.HostingProvider.Linode as Linode import qualified Propellor.Property.HostingProvider.DigitalOcean as DigitalOcean import qualified Propellor.Property.SiteSpecific.GitHome as GitHome @@ -97,9 +98,9 @@ clam :: Host clam = host "clam.kitenet.net" $ props - & standardSystem (Stable "stretch") X86_64 + & standardSystem (Stable "buster") X86_64 ["Unreliable server. Anything here may be lost at any time!" ] - & ipv4 "178.33.208.168" + & ipv4 "46.36.36.189" & User.hasPassword (User "root") & Ssh.hostKeys hostContext @@ -108,11 +109,10 @@ , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPhfvcOuw0Yt+MnsFc4TI2gWkKi62Eajxz+TgbHMO/uRTYF8c5V8fOI3o+J/3m5+lT0S5o8j8a7xIC3COvi+AVw=") ] & Apt.unattendedUpgrades - & Apt.serviceInstalledRunning "swapspace" - & Tor.isRelay - & Tor.named "kite1" - & Tor.bandwidthRate (Tor.PerMonth "400 GB") + -- & Tor.isRelay + -- & Tor.named "kite1" + -- & Tor.bandwidthRate (Tor.PerMonth "400 GB") & "/etc/resolv.conf" `File.hasContent` [ "nameserver 8.8.8.8" @@ -186,7 +186,7 @@ ) & JoeySites.cubieTruckOneWire & Systemd.persistentJournal - & Apt.installed ["firmware-atheros"] + & Apt.installed ["firmware-misc-nonfree"] -- wifi & Apt.serviceInstalledRunning "ntp" -- no hardware clock & bootstrappedFrom GitRepoOutsideChroot & Ssh.hostKeys hostContext @@ -307,7 +307,7 @@ & JoeySites.kgbServer & Systemd.nspawned ancientKitenet - & Systemd.nspawned openidProvider + ! Systemd.nspawned openidProvider & alias "podcatcher.kitenet.net" & JoeySites.podcatcher @@ -320,7 +320,7 @@ & myDnsPrimary "kitenet.net" [ (RelDomain "mouse-onion", CNAME $ AbsDomain "htieo6yu2qtcn2j3.onion") , (RelDomain "beaver-onion", CNAME $ AbsDomain "tl4xsvaxryjylgxs.onion") - , (RelDomain "peregrine-onion", CNAME $ AbsDomain "ahw47zqw6qszoufl.onion") + , (RelDomain "peregrine-onion", CNAME $ AbsDomain "rsdwvaabir6ty2kdzblq7wdda26ib4fuc6hzxzwum75jbn6thqbojvid.onion") , (RelDomain "sow-onion", CNAME $ AbsDomain "urt4g2tq32qktgtp.onion") ] & myDnsPrimary "joeyh.name" [] @@ -371,9 +371,10 @@ peregrine :: Host peregrine = host "peregrine.kitenet.net" $ props - & Apt.installed ["ssh"] + & Apt.installed ["ssh", "screen", "variety", "git-annex"] & Tor.installed & Tor.hiddenServiceAvailable "ssh" (Port 22) + & LightDM.autoLogin (User "desktop") -- Branchable is not completely deployed with propellor yet. pell :: Host diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 5.9.1 +Version: 5.10.1 Cabal-Version: 1.20 License: BSD2 Maintainer: Joey Hess diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -10,6 +10,7 @@ Debootstrapped(..), ChrootTarball(..), exposeTrueLocaldir, + useHostProxy, -- * Internal use provisioned', propagateChrootInfo, @@ -26,6 +27,7 @@ import Propellor.Types.Info import Propellor.Types.Core import Propellor.Property.Chroot.Util +import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Systemd.Core as Systemd import qualified Propellor.Property.File as File @@ -60,7 +62,11 @@ -- | Do initial bootstrapping of an operating system in a chroot. -- If the operating System is not supported, return -- Left error message. - buildchroot :: b -> Maybe System -> FilePath -> Either String (Property Linux) + buildchroot + :: b + -> Info -- ^ info of the Properties of the chroot + -> FilePath -- ^ where to bootstrap the chroot + -> Either String (Property Linux) -- | Use this to bootstrap a chroot by extracting a tarball. -- @@ -91,14 +97,28 @@ data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig instance ChrootBootstrapper Debootstrapped where - buildchroot (Debootstrapped cf) system loc = case system of + buildchroot (Debootstrapped cf) info loc = case system of (Just s@(System (Debian _ _) _)) -> Right $ debootstrap s (Just s@(System (Buntish _) _)) -> Right $ debootstrap s (Just (System ArchLinux _)) -> Left "Arch Linux not supported by debootstrap." (Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap." Nothing -> Left "Cannot debootstrap; OS not specified" where - debootstrap s = Debootstrap.built loc s cf + debootstrap s = Debootstrap.built loc s + (cf <> proxyConf <> mirrorConf) + system = fromInfoVal (fromInfo info) + -- If the chroot has a configured apt proxy and/or mirror, pass + -- these on to debootstrap. Note that Debootstrap.built does + -- not get passed the Chroot, so the info inspection has to + -- happen here, not there + proxyConf = case (fromInfoVal . fromInfo) info of + Just (Apt.HostAptProxy u) -> + Debootstrap.DebootstrapProxy u + Nothing -> mempty + mirrorConf = case (fromInfoVal . fromInfo) info of + Just (Apt.HostMirror u) -> + Debootstrap.DebootstrapMirror u + Nothing -> mempty -- | Defines a Chroot at the given location, built with debootstrap. -- @@ -106,6 +126,11 @@ -- add a property such as `osDebian` to specify the operating system -- to bootstrap. -- +-- If the 'Debootstrap.DebootstrapConfig' does not include a +-- 'Debootstrap.DebootstrapMirror', +-- any 'Apt.mirror' property of the chroot will configure debootstrap. +-- Same for 'Debootstrap.DebootstrapProxy' and 'Apt.proxy'. +-- -- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props -- > & osDebian Unstable X86_64 -- > & Apt.installed ["ghc", "haskell-platform"] @@ -115,6 +140,10 @@ -- | Defines a Chroot at the given location, bootstrapped with the -- specified ChrootBootstrapper. +-- +-- Like 'Chroot.debootstrapped', if the 'ChrootBootstrapper' is +-- 'Debootstrapped', this property respects the Chroot's +-- 'Apt.proxy' and 'Apt.mirror' properties. bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot bootstrapped bootstrapper location ps = c where @@ -143,7 +172,7 @@ setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly caps `requires` built - built = case buildchroot bootstrapper (chrootSystem c) loc of + built = case buildchroot bootstrapper (containerInfo c) loc of Right p -> p Left e -> cantbuild e @@ -304,3 +333,18 @@ propagateHostChrootInfo h c pinfo p = propagateContainer (hostName h) c pinfo $ p `setInfoProperty` chrootInfo c + +-- | Ensure that a chroot uses the host's Apt proxy. +-- +-- This property is often used for 'Sbuild.built' chroots, when the host has +-- 'Apt.useLocalCacher'. +useHostProxy :: Host -> Property DebianLike +useHostProxy h = property' "use host's apt proxy" $ \w -> + -- Note that we can't look at getProxyInfo outside the property, + -- as that would loop, but it's ok to look at it inside the + -- property. Thus the slightly strange construction here. + case getProxyInfo h of + Just (Apt.HostAptProxy u) -> ensureProperty w (Apt.proxy' u) + Nothing -> noChange + where + getProxyInfo = fromInfoVal . fromInfo . hostInfo diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -32,6 +32,8 @@ | BuilddD | DebootstrapParam String | UseEmulation + | DebootstrapProxy Url + | DebootstrapMirror Url | DebootstrapConfig :+ DebootstrapConfig deriving (Show) @@ -48,6 +50,8 @@ toParams BuilddD = [Param "--variant=buildd"] toParams (DebootstrapParam p) = [Param p] toParams UseEmulation = [] +toParams (DebootstrapProxy _) = [] +toParams (DebootstrapMirror _) = [] toParams (c1 :+ c2) = toParams c1 <> toParams c2 useEmulation :: DebootstrapConfig -> Bool @@ -55,6 +59,16 @@ useEmulation (a :+ b) = useEmulation a || useEmulation b useEmulation _ = False +debootstrapProxy :: DebootstrapConfig -> Maybe Url +debootstrapProxy (DebootstrapProxy u) = Just u +debootstrapProxy (a :+ b) = debootstrapProxy a <|> debootstrapProxy b +debootstrapProxy _ = Nothing + +debootstrapMirror :: DebootstrapConfig -> Maybe Url +debootstrapMirror (DebootstrapMirror u) = Just u +debootstrapMirror (a :+ b) = debootstrapMirror a <|> debootstrapMirror b +debootstrapMirror _ = Nothing + -- | Builds a chroot in the given directory using debootstrap. -- -- The System can be any OS and architecture that debootstrap @@ -99,11 +113,15 @@ [ Param $ "--arch=" ++ architectureToDebianArchString arch , Param suite , Param target - ] + ] ++ case debootstrapMirror config of + Just u -> [Param u] + Nothing -> [] cmd <- if useEmulation config then pure "qemu-debootstrap" else fromMaybe "debootstrap" <$> programPath - de <- standardPathEnv + de <- case debootstrapProxy config of + Just u -> addEntry "http_proxy" u <$> standardPathEnv + Nothing -> standardPathEnv ifM (boolSystemEnv cmd params (Just de)) ( return MadeChange , return FailedChange diff --git a/src/Propellor/Property/Localdir.hs b/src/Propellor/Property/Localdir.hs --- a/src/Propellor/Property/Localdir.hs +++ b/src/Propellor/Property/Localdir.hs @@ -9,6 +9,7 @@ import Propellor.Types.Info import Propellor.Types.Container import Propellor.Property.Mount (partialBindMountsOf, umountLazy) +import qualified Propellor.Property.Git as Git -- | Sets the url to use as the origin of propellor's git repository. -- @@ -19,8 +20,10 @@ -- When hosts are being updated without using -- --spin, eg when using -- the `Propellor.Property.Cron.runPropellor` cron job, this property can -- be set to redirect them to a new git repository url. -hasOriginUrl :: String -> Property (HasInfo + UnixLike) -hasOriginUrl u = setInfoProperty p (toInfo (InfoVal (OriginUrl u))) +hasOriginUrl :: String -> Property (HasInfo + DebianLike) +hasOriginUrl u = + setInfoProperty p (toInfo (InfoVal (OriginUrl u))) + `requires` Git.installed where p :: Property UnixLike p = property ("propellor repo url " ++ u) $ do diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -31,7 +31,7 @@ > & osDebian Unstable X86_32 > & Sbuild.osDebianStandard > & Sbuild.update `period` Weekly (Just 1) -> & Sbuild.useHostProxy mybox +> & Chroot.useHostProxy mybox If you are using sbuild older than 0.70.0, you also need: @@ -65,7 +65,6 @@ built, -- * Properties for use inside sbuild schroots update, - useHostProxy, osDebianStandard, -- * Global sbuild configuration -- blockNetwork, @@ -267,20 +266,6 @@ -- This replaces use of sbuild-update(1). update :: Property DebianLike update = Apt.update `before` Apt.upgrade `before` Apt.autoRemove - --- | Ensure that an sbuild schroot uses the host's Apt proxy. --- --- This property is typically used when the host has 'Apt.useLocalCacher'. -useHostProxy :: Host -> Property DebianLike -useHostProxy h = property' "use host's apt proxy" $ \w -> - -- Note that we can't look at getProxyInfo outside the property, - -- as that would loop, but it's ok to look at it inside the - -- property. Thus the slightly strange construction here. - case getProxyInfo of - Just (Apt.HostAptProxy u) -> ensureProperty w (Apt.proxy' u) - Nothing -> noChange - where - getProxyInfo = fromInfoVal . fromInfo . hostInfo $ h aptCacheLine :: String aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" 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 @@ -327,6 +327,8 @@ & endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/windows" -- git-annex distribution signing key & Gpg.keyImported (Gpg.GpgKeyId "89C809CB") (User "joey") + -- used for building rpms + & Apt.installed ["rpm", "createrepo"] where endpoint d = combineProperties ("endpoint " ++ d) $ props & File.dirExists d @@ -902,9 +904,10 @@ house :: IsContext c => User -> [Host] -> c -> (SshKeyType, Ssh.PubKeyText) -> Property (HasInfo + DebianLike) house user hosts ctx sshkey = propertyList "home automation" $ props & Apache.installed - & Apt.installed ["python", "python-pymodbus", "rrdtool", "rsync"] + & Apt.installed ["libmodbus-dev", "rrdtool", "rsync"] & Git.cloned user "https://git.joeyh.name/git/joey/house.git" d Nothing & Git.cloned user "https://git.joeyh.name/git/reactive-banana-automation.git" (d "reactive-banana-automation") Nothing + & Git.cloned user "https://git.joeyh.name/git/haskell-libmodbus.git" (d "haskell-libmodbus") Nothing & websitesymlink & build & Systemd.enabled setupservicename @@ -941,6 +944,8 @@ userScriptProperty (User "joey") [ "cd " ++ d "reactive-banana-automation" , "cabal install" + , "cd " ++ d "haskell-libmodbus" + , "cabal install" , "cd " ++ d , "make" ] @@ -1035,12 +1040,12 @@ createSymbolicLink d "/var/www/html" ) -homerouterWifiInterfaceOld :: String -homerouterWifiInterfaceOld = "wlx00c0ca82eb78" -- thinkpenguin wifi adapter - homerouterWifiInterface :: String -homerouterWifiInterface = "wlx7cdd90400448" -- small wifi dongle +homerouterWifiInterface = "wlx9cefd5fcd6f3" +homerouterWifiInterfaceOld :: String +homerouterWifiInterfaceOld = "wlx7cdd90753b9f" + -- My home router, running hostapd and dnsmasq, -- with eth0 connected to a satellite modem, and a fallback ppp connection. homeRouter :: Property (HasInfo + DebianLike) @@ -1083,16 +1088,19 @@ ] `onChange` Service.restarted "dnsmasq" & ipmasq homerouterWifiInterface - -- Used to bring down eth0 when satellite is off, which causes ppp - -- to start, but I am not using this currently. - & Apt.removed ["netplug"] & Network.static' "eth0" (IPv4 "192.168.1.100") (Just (Network.Gateway (IPv4 "192.168.1.1"))) -- When satellite is down, fall back to dialup [ ("pre-up", "poff -a || true") , ("post-down", "pon") + -- ethernet autonegotiation with satellite receiver + -- sometimes fails + , ("ethernet-autoneg", "off") + , ("link-speed", "100") + , ("link-duplex", "full") ] `requires` Network.cleanInterfacesFile + `requires` Apt.installed ["ethtool"] & Apt.installed ["ppp"] `before` File.hasContent "/etc/ppp/peers/provider" [ "user \"joeyh@arczip.com\"" @@ -1230,10 +1238,10 @@ [ "# let users power control startech hub with uhubctl" , "ATTR{idVendor}==\"" ++ hubvendor ++ "\", ATTR{idProduct}==\"005a\", MODE=\"0666\"" ] - & autoMountDrive "archive-10" (USBHubPort hubvendor 1) (Just "archive-older") - & autoMountDrive "archive-11" (USBHubPort hubvendor 2) (Just "archive-old") - & autoMountDrive "archive-12" (USBHubPort hubvendor 3) (Just "archive") - & autoMountDrive "passport" (USBHubPort hubvendor 4) Nothing + & autoMountDrive "archive-10" (USBHubPort hubvendor 1) (Just "archive-oldest") + & autoMountDrive "archive-11" (USBHubPort hubvendor 2) (Just "archive-older") + & autoMountDrive "archive-12" (USBHubPort hubvendor 3) (Just "archive-old") + & autoMountDrive "archive-13" (USBHubPort hubvendor 4) (Just "archive") & Apt.installed ["git-annex", "borgbackup"] where hubvendor = "0409" diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs --- a/src/Propellor/Types/Core.hs +++ b/src/Propellor/Types/Core.hs @@ -109,3 +109,6 @@ getInfo (ChildProperty _ _ i _) = i toChildProperty = id getSatisfy (ChildProperty _ a _ _) = a + +propsInfo :: Props metatypes -> Info +propsInfo (Props l) = mconcat (map getInfo l) 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 @@ -63,6 +63,7 @@ toInfo :: IsInfo v => v -> Info toInfo = addInfo mempty +-- | Extracts a value from an Info. fromInfo :: IsInfo v => Info -> v fromInfo (Info l) = mconcat (mapMaybe extractInfoEntry l)