propellor 5.3.1 → 5.3.2
raw patch · 11 files changed
+259/−19 lines, 11 files
Files
- CHANGELOG +13/−0
- README.md +5/−4
- debian/changelog +13/−0
- doc/README.mdwn +5/−4
- joeyconfig.hs +1/−4
- propellor.cabal +2/−1
- src/Propellor/EnsureProperty.hs +1/−0
- src/Propellor/Property/Atomic.hs +161/−0
- src/Propellor/Property/Git.hs +18/−0
- src/Propellor/Property/SiteSpecific/JoeySites.hs +38/−4
- src/Propellor/Property/Systemd.hs +2/−2
CHANGELOG view
@@ -1,3 +1,16 @@+propellor (5.3.2) unstable; urgency=medium++ * Added Propellor.Property.Atomic, which can make a non-atomic property+ that operates on a directory into an atomic property.+ (Inspired by Vaibhav Sagar's talk on Functional Devops in a+ Dysfunctional World at LCA 2018.)+ * Added Git.pulled.+ * Systemd.machined: Install systemd-container on Debian+ stretch.+ Thanks, Sean Whitton++ -- Joey Hess <id@joeyh.name> Sun, 18 Feb 2018 14:31:39 -0400+ propellor (5.3.1) unstable; urgency=medium * Last release mistakenly contained my personal branch not master.
README.md view
@@ -18,12 +18,10 @@ which includes many built-in Properties for dealing with [Apt](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Apt.html) and-[Apache](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Apache.html)-,+[Apache](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Apache.html), [Cron](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Cron.html) and-[Commands](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Cmd.html)-,+[Commands](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Cmd.html), [Dns](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Dns.html) and [Docker](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Docker.html), etc.@@ -56,3 +54,6 @@ each host becomes tiresome, you can [automate that](http://propellor.branchable.com/automated_spins/). 7. Write some neat new properties and send patches!++(Want to get your feet wet with propellor before plunging in?+[[try this|forum/Simple_quickstart_without_git__44___SSH__44___GPG]])
debian/changelog view
@@ -1,3 +1,16 @@+propellor (5.3.2) unstable; urgency=medium++ * Added Propellor.Property.Atomic, which can make a non-atomic property+ that operates on a directory into an atomic property.+ (Inspired by Vaibhav Sagar's talk on Functional Devops in a+ Dysfunctional World at LCA 2018.)+ * Added Git.pulled.+ * Systemd.machined: Install systemd-container on Debian+ stretch.+ Thanks, Sean Whitton++ -- Joey Hess <id@joeyh.name> Sun, 18 Feb 2018 14:31:39 -0400+ propellor (5.3.1) unstable; urgency=medium * Last release mistakenly contained my personal branch not master.
doc/README.mdwn view
@@ -18,12 +18,10 @@ which includes many built-in Properties for dealing with [Apt](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Apt.html) and-[Apache](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Apache.html)-,+[Apache](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Apache.html), [Cron](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Cron.html) and-[Commands](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Cmd.html)-,+[Commands](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Cmd.html), [Dns](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Dns.html) and [Docker](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Docker.html), etc.@@ -56,3 +54,6 @@ each host becomes tiresome, you can [automate that](http://propellor.branchable.com/automated_spins/). 7. Write some neat new properties and send patches!++(Want to get your feet wet with propellor before plunging in?+[[try this|forum/Simple_quickstart_without_git__44___SSH__44___GPG]])
joeyconfig.hs view
@@ -27,7 +27,6 @@ import qualified Propellor.Property.LetsEncrypt as LetsEncrypt import qualified Propellor.Property.Locale as Locale import qualified Propellor.Property.Grub as Grub-import qualified Propellor.Property.FlashKernel as FlashKernel import qualified Propellor.Property.Borg as Borg import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Systemd as Systemd@@ -193,9 +192,7 @@ `mountedAt` "/" `setSize` MegaBytes 8000 )- & File.hasPrivContentExposed "/etc/flash-kernel/dtbs/sun7i-a20-cubietruck.dtb"- (Context "cubietruck gpio")- `onChange` FlashKernel.flashKernel+ & JoeySites.cubieTruckOneWire & Apt.installed ["firmware-brcm80211"] -- Workaround for https://bugs.debian.org/844056
propellor.cabal view
@@ -1,5 +1,5 @@ Name: propellor-Version: 5.3.1+Version: 5.3.2 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -89,6 +89,7 @@ Propellor.Property.Apache Propellor.Property.Apt Propellor.Property.Apt.PPA+ Propellor.Property.Atomic Propellor.Property.Attic Propellor.Property.Bootstrap Propellor.Property.Borg
src/Propellor/EnsureProperty.hs view
@@ -8,6 +8,7 @@ ( ensureProperty , property' , OuterMetaTypesWitness(..)+ , Cannot_ensureProperty_WithInfo ) where import Propellor.Types
+ src/Propellor/Property/Atomic.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}++module Propellor.Property.Atomic (+ atomicDirUpdate,+ atomicDirSync,+ atomicUpdate,+ AtomicResourcePair(..),+ flipAtomicResourcePair,+ SwapAtomicResourcePair,+ CheckAtomicResourcePair,+) where++import Propellor.Base+import Propellor.Types.Core+import Propellor.Types.MetaTypes+import Propellor.EnsureProperty+import Propellor.Property.File+import Propellor.Property.Rsync (syncDir)++import System.Posix.Files++-- | A pair of resources, one active and one inactive, which can swap+-- positions atomically.+data AtomicResourcePair a = AtomicResourcePair+ { activeAtomicResource :: a+ , inactiveAtomicResource :: a+ }++flipAtomicResourcePair :: AtomicResourcePair a -> AtomicResourcePair a+flipAtomicResourcePair a = AtomicResourcePair+ { activeAtomicResource = inactiveAtomicResource a+ , inactiveAtomicResource = activeAtomicResource a+ }++-- | Action that activates the inactiveAtomicResource, and deactivates+-- the activeAtomicResource. This action must be fully atomic.+type SwapAtomicResourcePair a = AtomicResourcePair a -> Propellor Bool++-- | Checks which of the pair of resources is currently active and+-- which is inactive, and puts them in the correct poisition in+-- the AtomicResourcePair.+type CheckAtomicResourcePair a = AtomicResourcePair a -> Propellor (AtomicResourcePair a)++-- | Makes a non-atomic Property be atomic, by applying it to the +-- inactiveAtomicResource, and if it was successful,+-- atomically activating that resource.+atomicUpdate+ -- Constriaints inherited from ensureProperty.+ :: ( Cannot_ensureProperty_WithInfo t ~ 'True+ , (Targets t `NotSuperset` Targets t) ~ 'CanCombine+ )+ => SingI t+ => AtomicResourcePair a+ -> CheckAtomicResourcePair a+ -> SwapAtomicResourcePair a+ -> (a -> Property (MetaTypes t))+ -> Property (MetaTypes t)+atomicUpdate rbase rcheck rswap mkp = property' d $ \w -> do+ r <- rcheck rbase+ res <- ensureProperty w $ mkp $ inactiveAtomicResource r+ case res of+ FailedChange -> return FailedChange+ NoChange -> return NoChange+ MadeChange -> do+ ok <- rswap r+ if ok+ then return res+ else return FailedChange+ where+ d = getDesc $ mkp $ activeAtomicResource rbase++-- | Applies a Property to a directory such that the directory is updated+-- fully atomically; there is no point in time in which the directory will+-- be in an inconsistent state.+--+-- For example, git repositories are not usually updated atomically,+-- and so while the repository is being updated, the files in it can be a+-- mixture of two different versions, which could cause unexpected+-- behavior to consumers. To avoid such problems:+--+-- > & atomicDirUpdate "/srv/web/example.com"+-- > (\d -> Git.pulled "joey" "http://.." d Nothing)+--+-- This operates by making a second copy of the directory, and passing it+-- to the Property, which can make whatever changes it needs to that copy,+-- non-atomically. After the Property successfully makes a change, the+-- copy is swapped into place, fully atomically.+--+-- This necessarily uses double the disk space, since there are two copies+-- of the directory. The parent directory will actually contain three+-- children: a symlink with the name of the directory itself, and two copies+-- of the directory, with names suffixed with ".1" and ".2"+atomicDirUpdate+ -- Constriaints inherited from ensureProperty.+ :: ( Cannot_ensureProperty_WithInfo t ~ 'True+ , (Targets t `NotSuperset` Targets t) ~ 'CanCombine+ )+ => SingI t+ => FilePath+ -> (FilePath -> Property (MetaTypes t))+ -> Property (MetaTypes t)+atomicDirUpdate d = atomicUpdate (mkDirLink d) (checkDirLink d) (swapDirLink d)++mkDirLink :: FilePath -> AtomicResourcePair FilePath+mkDirLink d = AtomicResourcePair+ { activeAtomicResource = addext ".1"+ , inactiveAtomicResource = addext ".2"+ }+ where+ addext = addExtension (dropTrailingPathSeparator d)++inactiveLinkTarget :: AtomicResourcePair FilePath -> FilePath+inactiveLinkTarget = takeFileName . inactiveAtomicResource++swapDirLink :: FilePath -> SwapAtomicResourcePair FilePath+swapDirLink d rp = liftIO $ do+ v <- tryIO $ createSymbolicLink (inactiveLinkTarget rp)+ `viaStableTmp` d+ case v of+ Right () -> return True+ Left e -> do+ warningMessage $ "Unable to update symlink at " ++ d ++ " (" ++ show e ++ ")"+ return False++checkDirLink :: FilePath -> CheckAtomicResourcePair FilePath+checkDirLink d rp = liftIO $ do+ v <- tryIO $ readSymbolicLink d+ return $ case v of+ Right t | t == inactiveLinkTarget rp ->+ flipAtomicResourcePair rp+ _ -> rp++-- | This can optionally be used after atomicDirUpdate to rsync the changes+-- that were made over to the other copy of the directory. It's not+-- necessary to use this, but it can improve efficiency.+--+-- For example:+--+-- > & atomicDirUpdate "/srv/web/example.com"+-- > (\d -> Git.pulled "joey" "http://.." d Nothing)+-- > `onChange` atomicDirSync "/srv/web/example.com"+--+-- Using atomicDirSync in the above example lets git only download+-- the changes once, rather than the same changes being downloaded a second+-- time to update the other copy of the directory the next time propellor+-- runs.+--+-- Suppose that a web server program is run from the git repository,+-- and needs to be restarted after the pull. That restart should be done+-- after the atomicDirUpdate, but before the atomicDirSync. That way,+-- the old web server process will not have its files changed out from+-- under it.+--+-- > & atomicDirUpdate "/srv/web/example.com"+-- > (\d -> Git.pulled "joey" "http://.." d Nothing)+-- > `onChange` (webServerRestart `before` atomicDirSync "/srv/web/example.com")+atomicDirSync :: FilePath -> Property (DebianLike + ArchLinux)+atomicDirSync d = syncDir (activeAtomicResource rp) (inactiveAtomicResource rp)+ where+ rp = mkDirLink d
src/Propellor/Property/Git.hs view
@@ -61,6 +61,9 @@ -- it will be recursively deleted first. -- -- A branch can be specified, to check out.+--+-- Does not make subsequent changes be pulled into the repository after+-- it's cloned. cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike cloned owner url dir mbranch = check originurl go `requires` installed@@ -95,11 +98,26 @@ , Just "git update-server-info" ] +-- | Specified git repository is cloned to the specified directory,+-- and any new commits are pulled into it each time this property runs.+pulled :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike+pulled owner url dir mbranch = go+ `requires` cloned owner url dir mbranch+ `describe` desc+ where+ desc = "git pulled " ++ url ++ " to " ++ dir+ go = userScriptProperty owner+ [ "cd " ++ shellEscape dir+ , "git pull"+ ]+ `changesFile` (dir </> ".git" </> "FETCH_HEAD")+ isGitDir :: FilePath -> IO Bool isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", dir]) data GitShared = Shared Group | SharedAll | NotShared +-- | Sets up a new, empty bare git repository. bareRepo :: FilePath -> User -> GitShared -> Property UnixLike bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $ toProps $ dirExists repo : case gitshared of
src/Propellor/Property/SiteSpecific/JoeySites.hs view
@@ -541,7 +541,7 @@ , "smtpd_sasl_security_options = noanonymous" , "smtpd_sasl_local_domain = kitenet.net" - , "# Enable postgrey."+ , "# Enable postgrey and sasl auth and client certs." , "smtpd_recipient_restrictions = permit_tls_clientcerts,permit_sasl_authenticated,,permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023" , "# Enable spamass-milter, amavis-milter (opendkim is not enabled because it causes mails forwarded from eg gmail to be rejected)"@@ -668,7 +668,6 @@ postfixSaslPasswordClient :: Property (HasInfo + DebianLike) postfixSaslPasswordClient = combineProperties "postfix uses SASL password to authenticate with smarthost" $ props- & Postfix.satellite & Postfix.mappedFile "/etc/postfix/sasl_passwd" (`File.hasPrivContent` (Context "kitenet.net")) & Postfix.mainCfFile `File.containsLines`@@ -680,6 +679,9 @@ , "smtp_sasl_password_maps = hash:/etc/postfix/sasl_passwd" ] `onChange` Postfix.reloaded+ -- Comes after so it does not set relayhost but uses the setting + -- above.+ & Postfix.satellite hasPostfixCert :: Context -> Property (HasInfo + UnixLike) hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props@@ -1048,7 +1050,7 @@ , "ttf-bitstream-vera" , "mairix", "offlineimap", "mutt" , "nmap", "whois", "wireshark", "tcpdump", "iftop"- , "udevil", "pmount", "tree"+ , "udevil", "pmount", "tree", "pv" , "arbtt", "hledger", "bc" , "apache2", "ikiwiki", "libhighlight-perl" , "pal"@@ -1059,7 +1061,7 @@ , "vim-syntastic", "vim-fugitive" , "adb", "gthumb" , "w3m", "sm", "weechat"- , "borgbackup", "wipe"+ , "borgbackup", "wipe", "smartmontools", "libgfshare-bin" , "units" ] `requires` baseSoftware@@ -1079,3 +1081,35 @@ , "gdb", "dpkg-repack", "lintian" , "pristine-tar", "github-backup" ]++cubieTruckOneWire :: Property DebianLike+cubieTruckOneWire = + File.hasContent "/etc/easy-peasy-devicetree-squeezy/my.dts" mydts+ `onChange` utilitysetup+ `requires` utilityinstalled+ where+ utilityinstalled = Git.cloned (User "root") "https://git.joeyh.name/git/easy-peasy-devicetree-squeezy.git" "/usr/local/easy-peasy-devicetree-squeezy" Nothing+ `onChange` File.isSymlinkedTo "/usr/local/bin/easy-peasy-devicetree-squeezy" (File.LinkTarget "/usr/local/easy-peasy-devicetree-squeezy/easy-peasy-devicetree-squeezy")+ utilitysetup = cmdProperty "easy-peasy-devicetree-squeezy"+ ["--debian", "sun7i-a20-cubietruck"]+ `assume` MadeChange+ mydts =+ [ "/* Device tree addition enabling onewire sensors on CubieTruck GPIO pin PG8 */"+ , "#include <dt-bindings/gpio/gpio.h>"+ , ""+ , "/ {"+ , "\tonewire_device {"+ , "\t\tcompatible = \"w1-gpio\";"+ , "\t\tgpios = <&pio 6 8 GPIO_ACTIVE_HIGH>; /* PG8 */"+ , "\t\tpinctrl-names = \"default\";"+ , "\t\tpinctrl-0 = <&my_w1_pin>;"+ , "\t};"+ , "};"+ , ""+ , "&pio {"+ , "\tmy_w1_pin: my_w1_pin@0 {"+ , "\t\tallwinner,pins = \"PG8\";"+ , "\t\tallwinner,function = \"gpio_in\";"+ , "\t};"+ , "};"+ ]
src/Propellor/Property/Systemd.hs view
@@ -205,8 +205,8 @@ case o of -- Split into separate debian package since systemd 225. (Just (System (Debian _ suite) _))- | not (isStable suite) -> ensureProperty w $- Apt.installed ["systemd-container"]+ | not (isStable suite) || suite == (Stable "stretch") ->+ ensureProperty w $ Apt.installed ["systemd-container"] _ -> noChange -- | Defines a container with a given machine name,