diff options
99 files changed, 1772 insertions, 383 deletions
diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 00000000..5d425843 --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +debian/changelog merge=dpkg-mergechangelogs diff --git a/config-freebsd.hs b/config-freebsd.hs index 3ee3f27c..80abb89d 100644 --- a/config-freebsd.hs +++ b/config-freebsd.hs @@ -28,11 +28,11 @@ hosts = -- An example freebsd host. freebsdbox :: Host freebsdbox = host "freebsdbox.example.com" $ props - & osFreeBSD (FBSDProduction FBSD102) "amd64" + & osFreeBSD (FBSDProduction FBSD102) X86_64 & Pkg.update & Pkg.upgrade & Poudriere.poudriere poudriereZFS - & Poudriere.jail (Poudriere.Jail "formail" (fromString "10.2-RELEASE") (fromString "amd64")) + & Poudriere.jail (Poudriere.Jail "formail" (fromString "10.2-RELEASE") (fromArchitecture X86_64)) poudriereZFS :: Poudriere.Poudriere poudriereZFS = Poudriere.defaultConfig @@ -44,7 +44,7 @@ poudriereZFS = Poudriere.defaultConfig -- An example linux host. linuxbox :: Host linuxbox = host "linuxbox.example.com" $ props - & osDebian Unstable "amd64" + & osDebian' KFreeBSD Unstable X86_64 & Apt.stdSourcesList & Apt.unattendedUpgrades & Apt.installed ["etckeeper"] @@ -59,7 +59,7 @@ linuxbox = host "linuxbox.example.com" $ props -- A generic webserver in a Docker container. webserverContainer :: Docker.Container webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") $ props - & osDebian (Stable "jessie") "amd64" + & osDebian' KFreeBSD (Stable "jessie") X86_64 & Apt.stdSourcesList & Docker.publish "80:80" & Docker.volume "/var/www:/var/www" diff --git a/config-simple.hs b/config-simple.hs index 42b3d838..11a3c3a4 100644 --- a/config-simple.hs +++ b/config-simple.hs @@ -19,7 +19,7 @@ hosts = -- An example host. mybox :: Host mybox = host "mybox.example.com" $ props - & osDebian Unstable "amd64" + & osDebian Unstable X86_64 & Apt.stdSourcesList & Apt.unattendedUpgrades & Apt.installed ["etckeeper"] diff --git a/debian/README.source b/debian/README.source new file mode 100644 index 00000000..4e49e9c3 --- /dev/null +++ b/debian/README.source @@ -0,0 +1,15 @@ +The upstream changelog and Debian changelog are the same file; we use +dpkg-mergechangelogs to merge them together when upstream makes a new +release. + +This confuses dpkg-genchanges: since our X-1 changelog entry follows +upstream's X changelog entry, dpkg-genchanges thinks that this is a +revision and we don't need to include the upstream tarball in the +upload. + +To deal with this, pass -sa to dpkg-buildpackage. If using dgit, the +magic incantation is: + + dgit --ch:-sa [s]build + + -- Sean Whitton <spwhitton@spwhitton.name>, Thu, 23 Jun 2016 17:23:30 +0900 diff --git a/debian/changelog b/debian/changelog index 804f4c89..2b414362 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,68 @@ +propellor (3.1.0-1) unstable; urgency=medium + + * Package new upstream release. + * Add 0002-dpkg-mergechangelogs.patch to facilitate uploading with dgit. + Adding this patch ensures that HEAD matches the unpacked source package. + * Add README.source. + * Add 0003-fix-ccache-haddock.patch. + + -- Sean Whitton <spwhitton@spwhitton.name> Thu, 23 Jun 2016 18:31:41 +0900 + +propellor (3.1.0) unstable; urgency=medium + + * Architecture changed from String to an ADT. (API Change) + Transition guide: Change "amd64" to X86_64, "i386" to X86_32, + "armel" to ARMEL, etc. + Thanks, Félix Sipma. + * The Debian data type now includes a DebianKernel. (API Change) + This won't affect most config.hs, as osDebian defaults to + Linux. Added osDebian' can be used to specify a different kernel. + Thanks, Félix Sipma. + * Improve exception handling. A property that threw a non-IOException + used to stop the whole propellor run. Now, all non-async exceptions + only make the property that threw them fail. (Implicit API change) + * Added StopPropellorException and stopPropellorMessage which can be + used in the unusual case where a failure of one property should stop + propellor from trying to ensure any other properties. + * tryPropellor returns Either SomeException instead of Either IOException + (API change) + * Switch letsencrypt to certbot package name. + * Sbuild: Add keyringInsecurelyGenerated which is useful on throwaway + build VMs. + Thanks, Sean Whitton + * Added Propellor.Property.SiteSpecific.Exoscale. + Thanks, Sean Whitton + * Property.Reboot: Added toDistroKernel and toKernelNewerThan. + Thanks, Sean Whitton + * Added ConfFile.hasIniSection. + Thanks, Félix Sipma. + * Apt.install: When asked to install a package that apt does not know + about, it used to incorrectly succeed. Now it will fail. + * Property.Firejail: New module. + Thanks, Sean Whitton + * File: Write privdata files in binary rather than text, which avoids + failure when they do not contain valid unicode. + Thanks, Andrew Schurman + * Generalized fileProperty can now operate on a file as either a series + of lines, or a ByteString. + + [ Sean Whitton ] + * New info property Schroot.useOverlays to indicate whether you want schroots + set up by propellor to use the Linux kernel's OverlayFS. + * Schroot.overlaysInTmpfs sets Schroot.useOverlays info property. + * If you have indicated that you want schroots to use OverlayFS and the + current kernel does not support it, Sbuild.built will attempt to reboot + into a kernel that does, or fail if it can't find one. + * Sbuild.built will no longer add duplicate `aliases=UNRELEASED,sid...` lines + to more than one schroot config. It will not remove any such lines that the + previous version of propellor added, though. + * Sbuild.keypairGenerated works around Debian bug #792100 by creating the + directory /root/.gnupg in advance. + * Ccache.hasCache now sets the setgid bit on the cache directory, as + ccache requires. + + -- Joey Hess <id@joeyh.name> Wed, 22 Jun 2016 15:29:27 -0400 + propellor (3.0.5-1) unstable; urgency=medium * Package new upstream release. diff --git a/debian/libghc-propellor-doc.links b/debian/libghc-propellor-doc.links new file mode 100644 index 00000000..9bdc7bd7 --- /dev/null +++ b/debian/libghc-propellor-doc.links @@ -0,0 +1 @@ +/usr/share/doc/libghc-propellor-doc/changelog.Debian.gz /usr/share/doc/libghc-propellor-doc/changelog.gz diff --git a/debian/patches/0002-dpkg-mergechangelogs.patch b/debian/patches/0002-dpkg-mergechangelogs.patch new file mode 100644 index 00000000..da88f733 --- /dev/null +++ b/debian/patches/0002-dpkg-mergechangelogs.patch @@ -0,0 +1,11 @@ +Description: Set up dpkg-mergechangelogs + To deal with the merged upstream and Debian changelog. +Author: Sean Whitton <spwhitton@spwhitton.name> +Forwarded: not-needed + +--- + +--- /dev/null ++++ propellor-3.1.0/.gitattributes +@@ -0,0 +1 @@ ++debian/changelog merge=dpkg-mergechangelogs diff --git a/debian/patches/0003-fix-ccache-haddock.patch b/debian/patches/0003-fix-ccache-haddock.patch new file mode 100644 index 00000000..426f3935 --- /dev/null +++ b/debian/patches/0003-fix-ccache-haddock.patch @@ -0,0 +1,16 @@ +Description: fix haddock in Ccache.hs + The '^' breaks the build of libghc-propellor-doc +Author: Sean Whitton <spwhitton@spwhitton.name> +Forwarded: yes + +--- a/src/Propellor/Property/Ccache.hs ++++ b/src/Propellor/Property/Ccache.hs +@@ -100,7 +100,7 @@ group@(Group g) `hasCache` limit = (make + , groupWriteMode + , setGroupIDMode + ]) `onChange` fixSetgidBit +- -- ^ we use onChange to catch upgrades from ++ -- here, we use onChange to catch upgrades from + -- 3.0.5 where the setGroupIDMode line was not + -- present + & hasLimits path limit diff --git a/debian/patches/series b/debian/patches/series index 518b48b8..faf4d488 100644 --- a/debian/patches/series +++ b/debian/patches/series @@ -1 +1,3 @@ 0001-remove-README.Debian-from-propellor.cabal.patch +0002-dpkg-mergechangelogs.patch +0003-fix-ccache-haddock.patch diff --git a/doc/forum/Apt.install_return_ok_even_if_asked_something_impossible.mdwn b/doc/forum/Apt.install_return_ok_even_if_asked_something_impossible.mdwn new file mode 100644 index 00000000..2858a75a --- /dev/null +++ b/doc/forum/Apt.install_return_ok_even_if_asked_something_impossible.mdwn @@ -0,0 +1,14 @@ +Hello joey + +here the result of the Apt.installed [ "dgit", "pypi2dsc" ] + + apt installed dgit pypi2dsc ... ok + + +BUT + +pypi2dsc does not exist (it is pypi2deb) + +So there is something wrong with the installed property :) + +Cheers diff --git a/doc/forum/Apt.install_return_ok_even_if_asked_something_impossible/comment_1_9ce26e0a77c118c3b75bb00827a880b9._comment b/doc/forum/Apt.install_return_ok_even_if_asked_something_impossible/comment_1_9ce26e0a77c118c3b75bb00827a880b9._comment new file mode 100644 index 00000000..de841793 --- /dev/null +++ b/doc/forum/Apt.install_return_ok_even_if_asked_something_impossible/comment_1_9ce26e0a77c118c3b75bb00827a880b9._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2016-06-17T14:31:35Z" + content=""" +Implementation has: + + check (isInstallable ps) go + +So, if the packages are not isInstallable, nothing is done, and the property +succeeds. + +I think this check was intended to avoid running apt-get install unncessarily +when the packages are already installed. However, isInstalled doesn't +differentiate between a package being already installed and not available. + +So, fixing. +"""]] diff --git a/doc/forum/Bug_with_Sbuild.mdwn b/doc/forum/Bug_with_Sbuild.mdwn new file mode 100644 index 00000000..3891ba69 --- /dev/null +++ b/doc/forum/Bug_with_Sbuild.mdwn @@ -0,0 +1,68 @@ +Hello, I installed a machine with these properties + + + & sbuild (System (Debian Unstable) "i386") (Just proxy) + & Sbuild.piupartsConfFor (System (Debian Unstable) "i386") + & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly (Just 1) + & Sbuild.usableBy (User "picca") + & Sbuild.shareAptCache + +where + + + type Proxy = Maybe Url + + sbuild :: System -> Proxy -> RevertableProperty (HasInfo + Linux) Linux + sbuild system@(System dist arch) proxy = Sbuild.builtFor system `before` setup + where + setup :: RevertableProperty (HasInfo + Linux) Linux + setup = Chroot.provisioned chroot + chroot = Chroot.debootstrapped Debootstrap.BuilddD chrootdir $ props + & os + & case proxy of + (Just p) -> "/etc/apt/apt.conf.d/01proxy" `File.hasContent` ["Acquire::http::Proxy \"" ++ p ++ "\";"] + Nothing -> doNothing + & Apt.installed ["apt-transport-https"] + & Apt.stdSourcesList + & Apt.update `onChange` Apt.upgrade + & Apt.cacheCleaned + chrootdir :: FilePath + chrootdir = "/srv/chroot" </> + case dist of + (Debian suite) -> Apt.showSuite suite ++ "-" ++ arch + (Buntish suite) -> suite ++ "-" ++ arch + os = case dist of + (Debian suite) -> osDebian suite arch + + +But when I use it I get this error message + + + i686-linux-gnu-gcc -pthread -DNDEBUG -g -fwrapv -O2 -Wall -Wstrict-prototypes -fno-strict-aliasing -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -fPIC -I/usr/lib/python2.7/dist-packages/numpy/core/include -I/«PKGBUILDDIR»/src -I/usr/include/python2.7 -c /«PKGBUILDDIR»/python/cython/_fisx.cpp -o build/temp.linux-i686-2.7/«PKGBUILDDIR»/python/cython/_fisx.o + ccache: error: Failed to create directory /var/cache/ccache-sbuild/9/1: Permission denied + error: command 'i686-linux-gnu-gcc' failed with exit status 1 + E: pybuild pybuild:274: build: plugin distutils failed with: exit code=1: /usr/bin/python setup.py build + + picca@ORD03037:~/Debian/python-fisx/python-fisx$ ls -l /var/cache/ccache-sbuild/ + total 76 + drwxr-xr-x 2 root root 4096 juin 16 15:48 0 + drwxr-xr-x 2 root root 4096 juin 16 15:48 1 + drwxr-xr-x 2 root root 4096 juin 16 15:48 2 + drwxr-xr-x 2 root root 4096 juin 16 15:48 3 + drwxr-xr-x 2 root root 4096 juin 16 15:48 4 + drwxr-xr-x 2 root root 4096 juin 16 15:48 5 + drwxr-xr-x 2 root root 4096 juin 16 15:48 6 + drwxr-xr-x 2 root root 4096 juin 16 15:48 7 + drwxr-xr-x 2 root root 4096 juin 16 15:48 8 + drwxr-xr-x 2 root root 4096 juin 16 15:48 9 + drwxr-xr-x 2 root root 4096 juin 16 15:48 a + drwxr-xr-x 2 root root 4096 juin 16 15:48 b + drwxr-xr-x 2 root root 4096 juin 16 15:48 c + -rw-rw-r-- 1 picca instrumentation 16 juin 16 16:32 ccache.conf + drwxr-xr-x 2 root root 4096 juin 16 15:48 d + drwxr-xr-x 2 root root 4096 juin 16 15:48 e + drwxr-xr-x 2 root root 4096 juin 16 15:48 f + -r-xr-xr-x 1 root root 172 juin 16 15:48 sbuild-setup + drwxrwxr-x 2 picca instrumentation 4096 juin 16 16:32 tmp + + diff --git a/doc/forum/Bug_with_Sbuild/comment_1_31f5e3716bbea976d7eb780e15aa04b1._comment b/doc/forum/Bug_with_Sbuild/comment_1_31f5e3716bbea976d7eb780e15aa04b1._comment new file mode 100644 index 00000000..742d99b7 --- /dev/null +++ b/doc/forum/Bug_with_Sbuild/comment_1_31f5e3716bbea976d7eb780e15aa04b1._comment @@ -0,0 +1,28 @@ +[[!comment format=mdwn + username="picca" + subject="comment 1" + date="2016-06-17T07:50:41Z" + content=""" +here the manpage fo ccache + + SHARING A CACHE + A group of developers can increase the cache hit rate by sharing a cache directory. To share a cache without unpleasant side effects, the following conditions should to be met: + + · Use the same CCACHE_DIR environment variable setting. + + · Unset the CCACHE_HARDLINK environment variable. + + · Make sure everyone sets the CCACHE_UMASK environment variable to 002. This ensures that cached files are accessible to everyone in the group. + + · Make sure that all users have write permission in the entire cache directory (and that you trust all users of the shared cache). + + · Make sure that the setgid bit is set on all directories in the cache. This tells the filesystem to inherit group ownership for new directories. The command “find $CCACHE_DIR -type d | xargs chmod + g+s” might be useful for this. + + The reason to avoid the hard link mode is that the hard links cause unwanted side effects, as all links to a cached file share the file’s modification timestamp. This results in false dependencies to + be triggered by timestamp-based build systems whenever another user links to an existing file. Typically, users will see that their libraries and binaries are relinked without reason. + + You may also want to make sure that the developers have CCACHE_BASEDIR set appropriately, as discussed in the previous section + +it seems that a a setgid bit is required for all directory. +"""]] diff --git a/doc/forum/Bug_with_Sbuild/comment_2_3ca5ceb0ac97451c1eea00ec72b55896._comment b/doc/forum/Bug_with_Sbuild/comment_2_3ca5ceb0ac97451c1eea00ec72b55896._comment new file mode 100644 index 00000000..c2b34090 --- /dev/null +++ b/doc/forum/Bug_with_Sbuild/comment_2_3ca5ceb0ac97451c1eea00ec72b55896._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="spwhitton" + subject="comment 2" + date="2016-06-19T07:19:33Z" + content=""" +Thank you for reporting this and for finding the fix, Fred. In a branch I'll be submitting soon I have modified `Ccache.hasCache` to chmod setgid the cache root, and this should propagate to all newly created subdirectories. + +Joey: what do you think about adding `cmdProperty \"chmod\" [\"-R\", \"g+s\" \"/var/cache/ccache-foo\"]` to `Ccache.hasCache` to fix existing broken setups? In my view it would be better to just add a note to the changelog suggesting this fix, but I'm not sure what you think would be best. +"""]] diff --git a/doc/forum/Bug_with_Sbuild/comment_3_59b5bafd51d1255c4ab79e468afcca1c._comment b/doc/forum/Bug_with_Sbuild/comment_3_59b5bafd51d1255c4ab79e468afcca1c._comment new file mode 100644 index 00000000..fc12b9fe --- /dev/null +++ b/doc/forum/Bug_with_Sbuild/comment_3_59b5bafd51d1255c4ab79e468afcca1c._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 3""" + date="2016-06-20T17:53:24Z" + content=""" +I generally try to fix up after bugs in the implementation of properties, +because otherwise maintaining my hosts gets problimatic. + +In this case, the sbuild support is pretty new and probably not much +used, so I guess it's up to you. chmod -R is rather expensive. If there's +a cheap way to detect when that's needed and only run it then, that +would be ideal.. +"""]] diff --git a/doc/forum/Bug_with_Sbuild/comment_4_6777722f9a18832aad1f195e78e6ac03._comment b/doc/forum/Bug_with_Sbuild/comment_4_6777722f9a18832aad1f195e78e6ac03._comment new file mode 100644 index 00000000..70d3dc47 --- /dev/null +++ b/doc/forum/Bug_with_Sbuild/comment_4_6777722f9a18832aad1f195e78e6ac03._comment @@ -0,0 +1,7 @@ +[[!comment format=mdwn + username="spwhitton" + subject="comment 4" + date="2016-06-21T08:57:02Z" + content=""" +I found a way to do it and committed it to the branch we're discussing [[elsewhere|todo/merge_request:_changes_to_Reboot.hs/]]. +"""]] diff --git a/doc/forum/Propellor_from_unprivileged_account.mdwn b/doc/forum/Propellor_from_unprivileged_account.mdwn new file mode 100644 index 00000000..127cee44 --- /dev/null +++ b/doc/forum/Propellor_from_unprivileged_account.mdwn @@ -0,0 +1,4 @@ +I have a need to configure the properties of some machines for which I am not the primary administrator (in particular, this is at a university where the central IT group does the administration, but delegates some tasks to department via sudo or by reading specific files). I imagine that I would have write my own properties. Is there a special way to call propellor, or code changes that need to be made to have propellor do the git clone and build in a user's home directory? + +Best, +Jack diff --git a/doc/forum/Propellor_from_unprivileged_account/comment_1_9a093f5ee1473549cef0578d1b2d1054._comment b/doc/forum/Propellor_from_unprivileged_account/comment_1_9a093f5ee1473549cef0578d1b2d1054._comment new file mode 100644 index 00000000..01fff2a8 --- /dev/null +++ b/doc/forum/Propellor_from_unprivileged_account/comment_1_9a093f5ee1473549cef0578d1b2d1054._comment @@ -0,0 +1,21 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2016-06-09T20:06:05Z" + content=""" +Well propellor is normally built in the user's home directory and then +deploys updates to the hosts and is built and run as root on them. + +If you're wanting to only run propellor as a user, to manage some +user-specific properties, see the Propellor.Location module to change +the path where propellor depploys itself to on a host. + +And in Propellor.Spin it has several `"root@"` that you'd need to change to +make it ssh into the host as a different user. + +And, in Propellor.CmdLine, there's a check of `getRealUserID` to see if it's +running as root. + +I think that's everything that assumes root (aside from a great many +properties of course!), but can't swear to it. +"""]] diff --git a/doc/forum/Systemd_container_pre-setup_properties.mdwn b/doc/forum/Systemd_container_pre-setup_properties.mdwn new file mode 100644 index 00000000..1cb94d66 --- /dev/null +++ b/doc/forum/Systemd_container_pre-setup_properties.mdwn @@ -0,0 +1,3 @@ +When creating a systemd container, what would be the best way to execute properties before propellor is run inside the container proper? + +I'm trying to setup packages for networking in a systemd container, but I first need the network to get the packages. Ideally, we should be able to run a few properties on the chroot that are used when creating a systemd container (and therefore use the host network). So far, I've solved this by adding the properties in the Systemd.Core.installed property. Not nice, but works if all your systemd containers are the same. I've tried creating a chroot myself, tar it and pass that to Systemd.container, but things got a little complicated. It also requires additional properties on the host that have to be moved if the container moved to another host. diff --git a/doc/forum/Systemd_container_pre-setup_properties/comment_1_420b48d04f16fe5ca7a75c4720e50e1a._comment b/doc/forum/Systemd_container_pre-setup_properties/comment_1_420b48d04f16fe5ca7a75c4720e50e1a._comment new file mode 100644 index 00000000..45b8afd4 --- /dev/null +++ b/doc/forum/Systemd_container_pre-setup_properties/comment_1_420b48d04f16fe5ca7a75c4720e50e1a._comment @@ -0,0 +1,35 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2016-06-17T01:49:24Z" + content=""" +Currently, Chroot.provisioned' is passed a `systemdonly :: Bool`, +which limits the chroot provisioning to the Systemd.installed +property. + +What you want to do needs a more flexible interface there. +Add a `Maybe ChildProperty` parameter to specify what should be done +to finish provisioning the chroot. + +Then, change the Systemd.Container data type: + + -data Container = Container MachineName Chroot.Chroot Host + +data Container metatypes = Container + + { containerMachinName :: MachineName + + , containerChroot :: Chroot.Chroot + + , containerHost :: Host + + , containerChrootProvision :: Property metatypes + + } + +And Systemd.nspawned will pass +`(Just (toChildProperty (containerChrootProvision c)))` to `Chroot.provisioned'` + +Systemd.Container constructor functions will default to setting +`containerChrootProvision = Systemd.Core.installed`, but +the user can then change the Container to add more properties +to run in the chroot when provisioning it. + +(There's also a tricky bit where Systemd.nspawned needs to extract any info +from containerChrootProvision and add it onto its own info to propigate +it. If you do the rest of it, I will handle this tricky bit..) +"""]] diff --git a/doc/forum/cabal:_Unrecognised_flags:_propellor-config.mdwn b/doc/forum/cabal:_Unrecognised_flags:_propellor-config.mdwn new file mode 100644 index 00000000..dd8048a2 --- /dev/null +++ b/doc/forum/cabal:_Unrecognised_flags:_propellor-config.mdwn @@ -0,0 +1,106 @@ +G'day Joey. Trying to deploy to a new host and I'm hitting this error: + + cabal: Unrecognised flags: propellor-config + sh: 1: ./propellor: not found + propellor: user error (ssh ["-o","ControlPath=/home/craige/.ssh/propellor/os01.mcwhirter.io.sock","-o","ControlMa + ster=auto","-o","ControlPersist=yes","root@os01.mcwhirter.io","sh -c 'if [ ! -d /usr/local/propellor/.git ] ; the + n (if ! git --version >/dev/null; then apt-get update && DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install- + recommends --no-upgrade -y install git; fi && echo STATUSNeedGitClone) || echo STATUSNeedPrecompiled ; else cd /u + sr/local/propellor && if ! cabal configure >/dev/null 2>&1; then ( apt-get update ; DEBIAN_FRONTEND=noninteractiv + e apt-get -qq --no-upgrade --no-install-recommends -y install gnupg ; DEBIAN_FRONTEND=noninteractive apt-get -qq + --no-upgrade --no-install-recommends -y install ghc ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --n + o-install-recommends -y install cabal-install ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-inst + all-recommends -y install libghc-async-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install + -recommends -y install libghc-missingh-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install + -recommends -y install libghc-hslogger-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install + -recommends -y install libghc-unix-compat-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-inst + all-recommends -y install libghc-ansi-terminal-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no + -install-recommends -y install libghc-ifelse-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-i + nstall-recommends -y install libghc-network-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-in + stall-recommends -y install libghc-mtl-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install + -recommends -y install libghc-transformers-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-ins + tall-recommends -y install libghc-exceptions-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-i + nstall-recommends -y install libghc-stm-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-instal + l-recommends -y install libghc-text-dev ; DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-re + commends -y install make ; cabal update ; cabal install --only-dependencies ) || true; fi&& if ! test -x ./propel + lor; then cabal configure && cabal build propellor-config && ln -sf dist/build/propellor-config/propellor-config + propellor; fi;if test -x ./propellor && ! ./propellor --check; then cabal clean && cabal configure && cabal build + propellor-config && ln -sf dist/build/propellor-config/propellor-config propellor; fi && ./propellor --boot os01 + .mcwhirter.io ; fi'"] exited 127) + +When I build propellor manually on the remote host, same issue: + + /usr/local/propellor# cabal build propellor-config + cabal: Unrecognised flags: propellor-config + +Building without the propellor-config flag *appears* to work fine: + + /usr/local/propellor# cabal build + Building propellor-3.0.4... + Preprocessing executable 'propellor-config' for propellor-3.0.4... + ... + Linking dist/build/propellor-config/propellor-config ... + Preprocessing executable 'propellor' for propellor-3.0.4... + +So when I change line 39 in Bootstrap.hs to drop "propellor-config" it appears to work OK, locally: + + % ~/.propellor/propellor --spin os01.mcwhirter.io + Preprocessing executable 'propellor-config' for propellor-3.0.4... + [85 of 90] Compiling Propellor.Bootstrap ( src/Propellor/Bootstrap.hs, dist/build/propellor-config/propellor-config-tmp/Propellor/Bootstrap.o ) + Linking dist/build/propellor-config/propellor-config ... + Propellor build ... done + + You need a passphrase to unlock the secret key for + user: ???? + 4096-bit RSA key, ID ?????, created ???? + + [master 0e810ff] propellor spin + 1 file changed, 4 insertions(+), 3 deletions(-) + Git commit ... done + Resolving dependencies... + Configuring propellor-3.0.4... + Warning: 'license: BSD2' is not a recognised license. The known licenses are: + GPL, GPL-2, GPL-3, LGPL, LGPL-2.1, LGPL-3, BSD3, MIT, Apache, Apache-2.0, + PublicDomain, AllRightsReserved, OtherLicense + Building propellor-3.0.4... + Preprocessing executable 'propellor-config' for propellor-3.0.4... + Preprocessing executable 'propellor' for propellor-3.0.4... + Preprocessing library propellor-3.0.4... + ... + +However it still fails with the original error on the remote host, despite the new Bootstrap.hs having been copied in place correctly. + + % ~/.propellor/propellor --spin os01.mcwhirter.io + Preprocessing executable 'propellor-config' for propellor-3.0.4... + [85 of 90] Compiling Propellor.Bootstrap ( src/Propellor/Bootstrap.hs, dist/build/propellor-config/propellor-config-tmp/Propellor/Bootstrap.o ) + Linking dist/build/propellor-config/propellor-config ... + Propellor build ... done + + You need a passphrase to unlock the secret key for + user: ????? + 4096-bit RSA key, ID ?????, created ????? + + [master bf1b056] propellor spin + 1 file changed, 1 deletion(-) + Git commit ... done + Sending privdata (11 bytes) to os01.mcwhirter.io ... done + Sending git update to os01.mcwhirter.io ... done + remote: Counting objects: 5, done. + remote: Compressing objects: 100% (5/5), done. + remote: Total 5 (delta 4), reused 0 (delta 0) + From . + * branch HEAD -> FETCH_HEAD + cabal: Unrecognised flags: propellor-config + Resolving dependencies... + Configuring propellor-3.0.4... + Warning: 'license: BSD2' is not a recognised license. The known licenses are: + GPL, GPL-2, GPL-3, LGPL, LGPL-2.1, LGPL-3, BSD3, MIT, Apache, Apache-2.0, + PublicDomain, AllRightsReserved, OtherLicense + cabal: Unrecognised flags: propellor-config + propellor: cabal build failed + Shared connection to os01.mcwhirter.io closed. + propellor: remote propellor failed + +I feel like I'm working around another local issue but so far my "fix" has been in Bootstrap.hs. + +Thoughts? diff --git a/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_1_5742cd0937a47a14cf3dc41e003e3855._comment b/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_1_5742cd0937a47a14cf3dc41e003e3855._comment new file mode 100644 index 00000000..93d70dc0 --- /dev/null +++ b/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_1_5742cd0937a47a14cf3dc41e003e3855._comment @@ -0,0 +1,26 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2016-06-07T17:13:29Z" + content=""" +propellor-config is the name of the Executable component +in the cabal file that we want cabal to build. + + Usage: cabal build [FLAGS] + or: cabal build COMPONENTS [FLAGS] + +It's the COMPONENT shown in the cabal build help. It seems that your cabal +doesn't not understand this syntax. What version of cabal is that? + +(Based on the license warning, I'm guessing its an older version of cabal +than the 1.22.6.0 I'm using here. The cabal 1.20.0.3 in Debian stable also +supports this syntax.) + +Only building the propellor-config Executable is only an optimisation; +otherwise cabal build also builds propellor as a library which is not +needed here. So your workaround to drop that parameter should be ok. + +You probably need to rebuild propellor on the remote host manually +after updating the code there, since the remote host has a version of +propellor compiled such that it tries to recompile itself using that parameter.. +"""]] diff --git a/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_2_7121b4ceb44419c7a9b3b0c2ff76e52b._comment b/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_2_7121b4ceb44419c7a9b3b0c2ff76e52b._comment new file mode 100644 index 00000000..928f5d11 --- /dev/null +++ b/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_2_7121b4ceb44419c7a9b3b0c2ff76e52b._comment @@ -0,0 +1,26 @@ +[[!comment format=mdwn + username="craige@a46118dff5bc0fad85259759970d8b4b9fc377d7" + nickname="craige" + subject="comment 2" + date="2016-06-07T22:32:04Z" + content=""" +Local (Debian \"Stretch\"): + + % cabal -V + cabal-install version 1.22.9.0 + using version 1.22.8.0 of the Cabal library + +Remote (Buntish 14.04): + + # cabal -V + cabal-install version 1.16.0.2 + using version 1.16.0 of the Cabal library + +This host needs to remain 14.04 for reasons out of my control. + +When I land in a few hours, I'll try upgrading cabal on that host and I expect the problem will disappear. + +Thanks! + +(kicking myself for not thinking of cabal versions) +"""]] diff --git a/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_3_886748a3a28e33c90bbc5485eddc8efb._comment b/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_3_886748a3a28e33c90bbc5485eddc8efb._comment new file mode 100644 index 00000000..8c04f052 --- /dev/null +++ b/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_3_886748a3a28e33c90bbc5485eddc8efb._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 3""" + date="2016-06-08T17:07:09Z" + content=""" +This could be probed at runtime, I'd be willing to consider a patch +checking cabal --version if you want to develop one. + +(Propellor supports Debian stable, but Ubuntu 14.04 is older than that.) +"""]] diff --git a/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_4_7ee19c190d1acb8106079871dda7f521._comment b/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_4_7ee19c190d1acb8106079871dda7f521._comment new file mode 100644 index 00000000..83ebf6ec --- /dev/null +++ b/doc/forum/cabal:_Unrecognised_flags:_propellor-config/comment_4_7ee19c190d1acb8106079871dda7f521._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="craige@a46118dff5bc0fad85259759970d8b4b9fc377d7" + nickname="craige" + subject="Resolved" + date="2016-06-13T23:35:40Z" + content=""" +Cracked enough heads to get the box upgraded and the issue unsurpisingly vanished :-) +"""]] diff --git a/doc/forum/functions_that_yield_properties/comment_5_922e9e20c5326ceb695f7593d8bd72f5._comment b/doc/forum/functions_that_yield_properties/comment_5_922e9e20c5326ceb695f7593d8bd72f5._comment new file mode 100644 index 00000000..7cbcdd84 --- /dev/null +++ b/doc/forum/functions_that_yield_properties/comment_5_922e9e20c5326ceb695f7593d8bd72f5._comment @@ -0,0 +1,38 @@ +[[!comment format=mdwn + username="spwhitton" + subject="comment 5" + date="2016-06-07T07:32:49Z" + content=""" +Unfortunately, the more general type doesn't seem to work: + + withMyAcc + :: (SingI outer, Cannot_ensureProperty_WithInfo inner ~ 'True, + NotSuperset (Targets inner) (Targets outer) ~ 'CanCombine) + => Desc + -> (User -> Property (MetaTypes inner)) + -> Property (MetaTypes outer) + withMyAcc desc mkp = property' desc $ \w -> do + u <- getMyAcc + ensureProperty w (mkp u) + + accountForSean :: Property DebianLike + accountForSean = withMyAcc \"account for Sean\" User.accountFor + +yields + + src/Propellor/Property/SiteSpecific/SPW/Account.hs:85:18: + Couldn't match kind ‘*’ with ‘MetaType’ + Expected type: Property DebianLike + Actual type: Property (MetaTypes outer0) + In the expression: withMyAcc \"account for Sean\" User.accountFor + In an equation for ‘accountForSean’: + accountForSean = withMyAcc \"account for Sean\" User.accountFor + + src/Propellor/Property/SiteSpecific/SPW/Account.hs:85:47: + Couldn't match kind ‘MetaType’ with ‘*’ + Expected type: User -> Property (MetaTypes inner0) + Actual type: User -> Property DebianLike + In the second argument of ‘withMyAcc’, namely ‘User.accountFor’ + In the expression: withMyAcc \"account for Sean\" User.accountFor + +"""]] diff --git a/doc/forum/use_withUmask_in_a_property.mdwn b/doc/forum/use_withUmask_in_a_property.mdwn new file mode 100644 index 00000000..9ae7d7ba --- /dev/null +++ b/doc/forum/use_withUmask_in_a_property.mdwn @@ -0,0 +1,12 @@ +I'm trying to combine the following two properties: + + propertyList "generate new key file" $ props + & cmdProperty "openssl" + [ "genrsa" + , "4096" + , "> " ++ key + ] + `assume` MadeChange + & key `File.mode` combineModes [ownerReadMode, ownerWriteMode] + +I've tried to use withUmask, without success. Is there a way to do that? diff --git a/doc/forum/use_withUmask_in_a_property/comment_1_593c3e8b1499b4cc9cc7db74bb775506._comment b/doc/forum/use_withUmask_in_a_property/comment_1_593c3e8b1499b4cc9cc7db74bb775506._comment new file mode 100644 index 00000000..d52b4786 --- /dev/null +++ b/doc/forum/use_withUmask_in_a_property/comment_1_593c3e8b1499b4cc9cc7db74bb775506._comment @@ -0,0 +1,38 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2016-06-20T18:04:27Z" + content=""" + withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a + +That needs a monad, and propellor Property is not a monad itself. +But, a Property does contain an Propellor monad action, which is run to ensure +that the property is met. You can use withUmask inside that action. + +The problem then becomes, how to run a Property like +your `cmdProperty` inside the Propellor monad? + +The answer is, using `ensureProperty`. +[Documentation](http://hackage.haskell.org/package/propellor/docs/Propellor-EnsureProperty.html) + +Something like this is what you're looking for: + + foo = Property UnixLike + foo = property' "generate new key file" $ \w -> + withUmask filemode $ + ensureProperty w genrsa + where + filemode = -- something + + genrsa :: Property UnixLike + genrsa = cmdProperty "openssl" + [ "genrsa" + , "4096" + , "> " ++ key + ] + `assume` MadeChange + +Incidentially, cmdProperty runs a command without exposing it to the +shell, so I don't think the redirection in your example will work. +You probably want to use scriptProperty instead. +"""]] diff --git a/doc/forum/use_withUmask_in_a_property/comment_2_edefd952bdb96c8a6a5d705170a05a77._comment b/doc/forum/use_withUmask_in_a_property/comment_2_edefd952bdb96c8a6a5d705170a05a77._comment new file mode 100644 index 00000000..a569d068 --- /dev/null +++ b/doc/forum/use_withUmask_in_a_property/comment_2_edefd952bdb96c8a6a5d705170a05a77._comment @@ -0,0 +1,20 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 2""" + date="2016-06-20T18:36:07Z" + content=""" +Here's another, perhaps simpler way to do it. The `adjustPropertySatisfy` +function takes an existing Property and applies a function to the Propellor +action inside it. + + adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes + +So, given the `genrsa` Property from my example above, you could +modify its action to use withUmask: + + adjustPropertySatisfy genrsa (withUmask filemode) + +This is simpler, but less flexible since it causes the entire +Propellor action to be run with the specified umask, not just part of the +action. But it works well for your purpose I think. +"""]] diff --git a/doc/forum/use_withUmask_in_a_property/comment_3_5bdd79ed99f2b001d5dfc8a7d0b2c177._comment b/doc/forum/use_withUmask_in_a_property/comment_3_5bdd79ed99f2b001d5dfc8a7d0b2c177._comment new file mode 100644 index 00000000..3a9f89c2 --- /dev/null +++ b/doc/forum/use_withUmask_in_a_property/comment_3_5bdd79ed99f2b001d5dfc8a7d0b2c177._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="gueux" + subject="comment 3" + date="2016-06-20T18:49:30Z" + content=""" +Thanks! + +By reading Cmd.hs, I've managed to get this: + + createKey :: FilePath -> Property UnixLike + createKey key = property (\"new private key file: \" ++ key) $ liftIO $ withUmask 0o0177 $ withFile key WriteMode $ \h -> + cmdResult <$> boolSystem' \"openssl\" [Param \"genrsa\", Param \"4096\"] (\p -> p { std_out = UseHandle h }) + + cmdResult :: Bool -> Result + cmdResult False = FailedChange + cmdResult True = NoChange + +"""]] diff --git a/doc/forum/use_withUmask_in_a_property/comment_4_13bfe4aec95f5e72f4f61b764fb29a5a._comment b/doc/forum/use_withUmask_in_a_property/comment_4_13bfe4aec95f5e72f4f61b764fb29a5a._comment new file mode 100644 index 00000000..0a45cdfc --- /dev/null +++ b/doc/forum/use_withUmask_in_a_property/comment_4_13bfe4aec95f5e72f4f61b764fb29a5a._comment @@ -0,0 +1,7 @@ +[[!comment format=mdwn + username="gueux" + subject="comment 4" + date="2016-06-21T09:42:31Z" + content=""" +Is there a equivalent of `withUmask` for `withFile`? The latter seems harder to interact with... +"""]] diff --git a/doc/forum/use_withUmask_in_a_property/comment_5_da0074f18fe0ce020325a9f59f44cb1d._comment b/doc/forum/use_withUmask_in_a_property/comment_5_da0074f18fe0ce020325a9f59f44cb1d._comment new file mode 100644 index 00000000..c566bb64 --- /dev/null +++ b/doc/forum/use_withUmask_in_a_property/comment_5_da0074f18fe0ce020325a9f59f44cb1d._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 5""" + date="2016-06-22T19:24:43Z" + content=""" +Unfortunately `withFile` uses IO, instead of being generalized to MonadIO, +so the approaches that work with `withUmask` don't work with it. + +One way is to write a version of withFile that's generalized to MonadIO: + + withFile' :: (MonadIO m, MonadMask m) => FilePath -> IOMode -> (Handle -> m r) -> m r + withFile' name mode = bracket (liftIO $ openFile name mode) (liftIO . hClose) +"""]] diff --git a/doc/haskell_newbie.mdwn b/doc/haskell_newbie.mdwn index bd343cd6..d6e339ed 100644 --- a/doc/haskell_newbie.mdwn +++ b/doc/haskell_newbie.mdwn @@ -48,12 +48,12 @@ Finally, you need to define the configuration for each host in the list: [[!format haskell """ mylaptop :: Host mylaptop = host "mylaptop.example.com" - & osDebian Unstable "amd64" + & osDebian Unstable X86_64 & Apt.stdSourcesList myserver :: Host myserver = host "server.example.com" - & osDebian (Stable "jessie") "amd64" + & osDebian (Stable "jessie") X86_64 & Apt.stdSourcesList & Apt.installed ["ssh"] """]] diff --git a/doc/news/version_2.15.4.mdwn b/doc/news/version_2.15.4.mdwn deleted file mode 100644 index 4e20bcc9..00000000 --- a/doc/news/version_2.15.4.mdwn +++ /dev/null @@ -1,15 +0,0 @@ -propellor 2.15.4 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * Build /usr/src/propellor/propellor.git reproducibly, - which makes the whole Debian package build reproducibly. - Thanks, Sean Whitton. - * Obnam: To cause old generations to be forgotten, keepParam can be - passed to a backup property; this causes obnam forget to be run. - * Delete /etc/apt/apt.conf.d/50unattended-upgrades.ucf-dist when - unattended-upgrades is installed, to work around #812380 which results - in many warnings from apt, including in cron mails. - * Added Propellor.Property.LetsEncrypt - * Apache.httpsVirtualHost: New property, setting up a https vhost - with the certificate automatically obtained using letsencrypt. - * Allow using combineProperties and propertyList with lists of - RevertableProperty."""]]
\ No newline at end of file diff --git a/doc/news/version_2.16.0.mdwn b/doc/news/version_2.16.0.mdwn deleted file mode 100644 index b7527f05..00000000 --- a/doc/news/version_2.16.0.mdwn +++ /dev/null @@ -1,18 +0,0 @@ -propellor 2.16.0 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * Obnam: Only let one backup job run at a time when a host has multiple - different backup properties, to avoid concurrent jobs fighting over - scarce resources (particularly memory). Other jobs block on a lock - file. - * Removed references to a Debian derivative from code and documentation - because of an unfortunate trademark use policy. - http://joeyh.name/blog/entry/trademark\_nonsense/ - * That included changing a data constructor to "Buntish", an API change. - * Firewall.rule: Now takes a Table parameter. (API change) - * Firewall: add InIFace/OutIFace Rules, add Source/Destination Rules, - add CustomTarget, and more improvements. - Thanks, Félix Sipma. - * Ssh.authorizedKey: Fix bug preventing it from working when the - authorized\_keys file does not yet exist. - * Removed Ssh.unauthorizedKey and made Ssh.authorizedKey revertable. - (API change)"""]]
\ No newline at end of file diff --git a/doc/news/version_2.17.0.mdwn b/doc/news/version_2.17.0.mdwn deleted file mode 100644 index 4149dbab..00000000 --- a/doc/news/version_2.17.0.mdwn +++ /dev/null @@ -1,30 +0,0 @@ -propellor 2.17.0 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * Added initial support for FreeBSD. - Thanks, Evan Cofsky. - * Added Propellor.Property.ZFS. - Thanks, Evan Cofsky. - * Firewall: Reorganized Chain data type. (API change) - Thanks, Félix Sipma. - * Firewall: Separated Table and Target (API change) - Thanks, Félix Sipma. - * Ssh: change type of listenPort from Int to Port (API change) - Thanks, Félix Sipma. - * Firewall: add TCPFlag, Frequency, TCPSyn, ICMPTypeMatch, NatDestination - Thanks, Félix Sipma. - * Network: Filter out characters not allowed in interfaces.d files. - Thanks, Félix Sipma. - * Apt.upgrade: Run dpkg --configure -a first, to recover from - interrupted upgrades. - * Apt: Add safeupgrade. - * Force ssh, scp, and git commands to be run in the foreground. - Should fix intermittent hangs of propellor --spin. - * Avoid repeated re-building on systems such as FreeBSD where building - re-links the binary even when there are no changes. - * Locale.available: Run locale-gen, instead of dpkg-reconfigure locales, - which modified the locale.gen file and sometimes caused the property to - need to make changes every time. - * Speed up propellor's build of itself, by asking cabal to only build - the propellor-config binary and not all the libraries. - * Tor.named: Fix bug that sometimes caused the property to fail the first - time, though retrying succeeded."""]]
\ No newline at end of file diff --git a/doc/news/version_2.17.1.mdwn b/doc/news/version_2.17.1.mdwn deleted file mode 100644 index 22727666..00000000 --- a/doc/news/version_2.17.1.mdwn +++ /dev/null @@ -1,8 +0,0 @@ -propellor 2.17.1 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * Avoid generating excessively long paths to the unix socket file - used for ssh connection caching. Mostly. Can still generate a too long - one if $HOME is longer than 60 bytes. - * Uwsgi: add ".ini" extension to app config files. - Files without extensions were ignored by uwsgi. - Thanks, Félix Sipma."""]]
\ No newline at end of file diff --git a/doc/news/version_2.17.2.mdwn b/doc/news/version_2.17.2.mdwn deleted file mode 100644 index 3b11ec89..00000000 --- a/doc/news/version_2.17.2.mdwn +++ /dev/null @@ -1,8 +0,0 @@ -propellor 2.17.2 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * When new dependencies are added to propellor or the propellor config, - try harder to get them installed. In particular, this makes - propellor --spin work when the remote host needs to get dependencies - installed in order to build the updated config. - * Apt.update: Also run dpkg --configure -a here as apt for some reason - won't even update if dpkg was interrupted."""]]
\ No newline at end of file diff --git a/doc/news/version_3.0.4.mdwn b/doc/news/version_3.0.4.mdwn deleted file mode 100644 index f6e1eac2..00000000 --- a/doc/news/version_3.0.4.mdwn +++ /dev/null @@ -1,8 +0,0 @@ -propellor 3.0.4 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * Run letsencrypt with --noninteractive. - * Fix build with ghc 8.0.1. - Thanks, davean. - * Module added for the Borg backup system. - Thanks, Félix Sipma. - * Fix build with directory-1.2.6.2."""]]
\ No newline at end of file diff --git a/doc/news/version_3.0.5.mdwn b/doc/news/version_3.0.5.mdwn new file mode 100644 index 00000000..b9655cf5 --- /dev/null +++ b/doc/news/version_3.0.5.mdwn @@ -0,0 +1,8 @@ +propellor 3.0.5 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * Modules added for Sbuild and Ccache. + Thanks, Sean Whitton + * Systemd: Added killUserProcesses property, which can be reverted + to return systemd to its default behavior before version 230 started + killing processes like screen sessions. + * Systemd: Added logindConfigured property."""]]
\ No newline at end of file diff --git a/doc/todo/bytes_in_privData__63__.mdwn b/doc/todo/bytes_in_privData__63__.mdwn index 27297fd5..66e3b1c2 100644 --- a/doc/todo/bytes_in_privData__63__.mdwn +++ b/doc/todo/bytes_in_privData__63__.mdwn @@ -15,3 +15,5 @@ It seems like I can't set the content of a PrivFile to arbitrary bytes. Enter private data on stdin; ctrl-D when done: propellor: <stdin>: hGetContents: invalid argument (invalid byte sequence) + +> [[done]]! --[[Joey]] diff --git a/doc/todo/bytes_in_privData__63__/comment_10_7812a96a98405d924a69e998dd42f275._comment b/doc/todo/bytes_in_privData__63__/comment_10_7812a96a98405d924a69e998dd42f275._comment new file mode 100644 index 00000000..602f91f0 --- /dev/null +++ b/doc/todo/bytes_in_privData__63__/comment_10_7812a96a98405d924a69e998dd42f275._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="andrew" + subject="comment 10" + date="2016-06-17T05:25:08Z" + content=""" +I've recreated my propellor repository a few times and have had to write out .pfx files. Essentially a binary format of .pem and .key. I had no problem getting the pfx file into privData, but propellor bails when writing the binary data on the host. This patch tackles the writing on host bit (not the writing to privData). You've used `hPutStr` to write out data which errors on certain bytes (because `hPutStr` assumes a character encoding?). 0x00 is a likely candidate. I don't recall the exact error, but at least Haskell noticed this and gave an error rather than writing out a partial file. + +I'll see if I can get a deduping patch to tidy up fileProperty and byteProperty. +"""]] diff --git a/doc/todo/bytes_in_privData__63__/comment_11_3839f018cbbd1043e645bf728162dea1._comment b/doc/todo/bytes_in_privData__63__/comment_11_3839f018cbbd1043e645bf728162dea1._comment new file mode 100644 index 00000000..93094e84 --- /dev/null +++ b/doc/todo/bytes_in_privData__63__/comment_11_3839f018cbbd1043e645bf728162dea1._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 11""" + date="2016-06-17T13:16:17Z" + content=""" +Hmm, the way Strings are used for PrivData takes advantage of ghc's +"filename encoding", which is supposed to allow arbitrary bytes to be +included in filenames; unicode surrogate characters are used to map +them to unicode. + +But, Property.File is using readFile, witeFile, and writeFileProtected, +which will bail on invalid unicode as the filename encoding is not used. +Your patch avoids that problem I see. +"""]] diff --git a/doc/todo/bytes_in_privData__63__/comment_12_a4edd5e06854a4b37eeb6b3db5c01947._comment b/doc/todo/bytes_in_privData__63__/comment_12_a4edd5e06854a4b37eeb6b3db5c01947._comment new file mode 100644 index 00000000..1d645d09 --- /dev/null +++ b/doc/todo/bytes_in_privData__63__/comment_12_a4edd5e06854a4b37eeb6b3db5c01947._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 12""" + date="2016-06-19T17:53:17Z" + content=""" +I found a reasonable way to refactor it without the duplication, so have +landed the patch. +"""]] diff --git a/doc/todo/bytes_in_privData__63__/comment_8_07f4a5604e51ee3114853e5017ef2a5f._comment b/doc/todo/bytes_in_privData__63__/comment_8_07f4a5604e51ee3114853e5017ef2a5f._comment new file mode 100644 index 00000000..11010dd2 --- /dev/null +++ b/doc/todo/bytes_in_privData__63__/comment_8_07f4a5604e51ee3114853e5017ef2a5f._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="andrew" + subject="comment 8" + date="2016-06-15T06:44:55Z" + content=""" +This has bit me one too many times, so here is a full implementation. There could be some dedup work to merge fileProperty and byteProperty, but I'd rather not break API with a trivial bug fix. + +<https://github.com/arcticwaters/propellor/commit/f5a921760ccabf0a3ebdda626c19ee6ecbe89629> +"""]] diff --git a/doc/todo/bytes_in_privData__63__/comment_9_7c87ab0fba0aa90e2b24b457851b63c4._comment b/doc/todo/bytes_in_privData__63__/comment_9_7c87ab0fba0aa90e2b24b457851b63c4._comment new file mode 100644 index 00000000..b904351a --- /dev/null +++ b/doc/todo/bytes_in_privData__63__/comment_9_7c87ab0fba0aa90e2b24b457851b63c4._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 9""" + date="2016-06-17T01:33:05Z" + content=""" +Thank you, Andrew! + +Before I merge this, I want to clear up something that confuses me; +you characterized this as a bug that has bit you. How did the +pre-bytestring File.hasContentProtected exhibit buggy behavior? + +AFAICS, it already supported binary privdata, just in a suboptimal +way. + +(Also fileProperty and bytesProperty should indeed be deduped; +a second patch that merges them, even with an API change, would be ok.) +"""]] diff --git a/doc/todo/integrate_shell-monad/comment_1_202c24d0a757d5086f65721fc2779131._comment b/doc/todo/integrate_shell-monad/comment_1_202c24d0a757d5086f65721fc2779131._comment new file mode 100644 index 00000000..bfa5e3b1 --- /dev/null +++ b/doc/todo/integrate_shell-monad/comment_1_202c24d0a757d5086f65721fc2779131._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="gueux" + subject="comment 1" + date="2016-06-13T17:31:37Z" + content=""" +How would you see the integration of shell-monad or turtle? + +Do you have a preference? + +I actually use turtle and it is great! It may be more complete than shell-monad which may be an advantage or a disadvantage... +"""]] diff --git a/doc/todo/integrate_shell-monad/comment_2_4e82a5994b4647b4483c92c7785ee905._comment b/doc/todo/integrate_shell-monad/comment_2_4e82a5994b4647b4483c92c7785ee905._comment new file mode 100644 index 00000000..0779c49f --- /dev/null +++ b/doc/todo/integrate_shell-monad/comment_2_4e82a5994b4647b4483c92c7785ee905._comment @@ -0,0 +1,39 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 2""" + date="2016-06-13T20:23:37Z" + content=""" +One easy way would be something like: + + shellMonadProperty :: Control.Monad.Shell.Script Result -> Property UnixLike + +But, I don't know if that would really be useful. The better use case for +shell-monad seems to be where things like `userScriptProperty` take a +`Script`, that is currently an alias for `String`. Since shell-monad can +generate a shell script, it would be easy to write: + + shellMonad :: Control.Monad.Shell.Script () -> Script + +Or, perhaps change userScriptProperty to accept either a stringy-Script or +a shell monad Script, via a type class. Then it could be used like this: + + userScriptProperty (User "joey") $ do + cmd "echo" "hello" + cmd "rm" "/home/joey/something" + +Turtle seems to not have its own monad but simply uses MonadIO. So seems +you can use Turtle in the implementation of propellor properties the same as +other IO actions. Which is great, it should be easy to use it if you want +to. Something like: + + import Turtle.Prelude + + myProperty :: Property UnixLike + myProperty = property "my property using turtle" $ liftIO $ do + echo "hello" + rm "/something" + return NoChange + +But I don't think turtle can generate shell scripts like used by +`userScriptProperty`. +"""]] diff --git a/doc/todo/integrate_shell-monad/comment_3_155d4af99bbbd8681a9924198aa7da73._comment b/doc/todo/integrate_shell-monad/comment_3_155d4af99bbbd8681a9924198aa7da73._comment new file mode 100644 index 00000000..48d25d7f --- /dev/null +++ b/doc/todo/integrate_shell-monad/comment_3_155d4af99bbbd8681a9924198aa7da73._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="gueux" + subject="comment 3" + date="2016-06-14T10:56:04Z" + content=""" +I've posted a question on https://github.com/Gabriel439/Haskell-Turtle-Library/issues/157 + +Probably Gabriel will have a good idea for this :-). Maybe another solution would be to generate executables instead of shell scripts? + + +"""]] diff --git a/doc/todo/integrate_shell-monad/comment_4_4914d37a548e1a19733156fbd77142a6._comment b/doc/todo/integrate_shell-monad/comment_4_4914d37a548e1a19733156fbd77142a6._comment new file mode 100644 index 00000000..77f30917 --- /dev/null +++ b/doc/todo/integrate_shell-monad/comment_4_4914d37a548e1a19733156fbd77142a6._comment @@ -0,0 +1,20 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 4""" + date="2016-06-14T17:11:09Z" + content=""" +We already have /usr/local/bin/propellor executable, so the cron job or +whatever could be made to run it with a parameter that runs the turtle IO +action. (Or generally, any IO action.. Being able to run arbitrary haskell +IO code as a cron job would be great!) + +This would need some way to get a `UniqueId` for an IO action, that is +stable across runs of propellor, and a way to build up a` Map UniqueId (IO ())` of such +actions. The Info interface could be used to build up that Map. + +---- + +Some of the places I'd like to use shell-monad though are where propellor +is bootstrapping itself on a host and all it can easily run at that point +is shell script. +"""]] diff --git a/doc/todo/integrate_shell-monad/comment_5_315c81503d6aea67b2b762ff3e435445._comment b/doc/todo/integrate_shell-monad/comment_5_315c81503d6aea67b2b762ff3e435445._comment new file mode 100644 index 00000000..9c185bd2 --- /dev/null +++ b/doc/todo/integrate_shell-monad/comment_5_315c81503d6aea67b2b762ff3e435445._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="gueux" + subject="comment 5" + date="2016-06-15T10:41:53Z" + content=""" +That would be over cool! :-) + +I don't see how to create these UniqueIds, though. I'm not sure I could help a lot on this one (at least before we have a first prototype)... +"""]] diff --git a/doc/todo/integrate_shell-monad/comment_6_d0328983a68958a914bd9fc9fe5a3abe._comment b/doc/todo/integrate_shell-monad/comment_6_d0328983a68958a914bd9fc9fe5a3abe._comment new file mode 100644 index 00000000..8ba13e99 --- /dev/null +++ b/doc/todo/integrate_shell-monad/comment_6_d0328983a68958a914bd9fc9fe5a3abe._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2016-06-16T21:04:55Z" + content=""" +Could use a tuple of a Data.Unique for the current build of propellor, +and a propellor build ID (eg, git rev that was built). + +That would make sure that propellor runs the correct IO action. +But, when propellor is updated, any cron jobs etc that try to run +with the old UniqueId would fail. Unless the old propellor binary +could be cached away and used as a fallback, I suppose.. +"""]] diff --git a/doc/todo/merge_request:_Firejail.hs.mdwn b/doc/todo/merge_request:_Firejail.hs.mdwn new file mode 100644 index 00000000..b593c5b4 --- /dev/null +++ b/doc/todo/merge_request:_Firejail.hs.mdwn @@ -0,0 +1,16 @@ +Please consider merging branch `firejail` of repo `https://git.spwhitton.name/propellor`. + +Changes: + +- Add `applytoList` property combinator +- Add `Propellor.Property.Firejail` module + +Comments: + +- I'm not sure whether Joey or I originally wrote `applyToList`; it's been in my config.hs for a while +- `Firejail.jailed` accepts a list of executables (and `Firejail.jailed'` is not exported) because as with `Apt.installed`, I think most users will want to jail more than one program. For example `Firejail.jailed ["firefox", "evince"]`. +- I made the build clean on GHC 7.10 but there is a warning on 7.6 that `Prelude` does not export `Foldable`. I don't know how to fix this while maintaining the 7.10 clean build, and it seems to me that having the 7.10 build be clean is more important than having the 7.6 build be clean. + +--spwhitton + +> [[done]], thanks! (I fixed the warning.) --[[Joey]] diff --git a/doc/todo/merge_request:_Sbuild.keypairInsecurelyGenerated.mdwn b/doc/todo/merge_request:_Sbuild.keypairInsecurelyGenerated.mdwn new file mode 100644 index 00000000..7a22e976 --- /dev/null +++ b/doc/todo/merge_request:_Sbuild.keypairInsecurelyGenerated.mdwn @@ -0,0 +1,5 @@ +Please consider merging branch `insecure-sbuild-keygen` from repo `https://git.spwhitton.name/propellor`. + +- Adds `Sbuild.keyringInsecurelyGenerated` which is useful on throwaway build VMs + +> [[merged|done]] --[[Joey]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs.mdwn b/doc/todo/merge_request:_changes_to_Reboot.hs.mdwn new file mode 100644 index 00000000..a6dec37b --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs.mdwn @@ -0,0 +1,7 @@ +Please consider merging branch `reboot` of repo `https://git.spwhitton.name/propellor` + +- Factor out reboot code in `Propellor.Property.SiteSpecific.DigitalOcean` into `Propellor.Property.Reboot` +- Add `Propellor.Property.Reboot.toKernelNewerThan`. +- Add `Propellor.Property.SiteSpecific.Exoscale` + +> [[done]]; all changes merged --[[Joey]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_10_d353b81063c5343b452f8c6e0fce5586._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_10_d353b81063c5343b452f8c6e0fce5586._comment new file mode 100644 index 00000000..04b02aea --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_10_d353b81063c5343b452f8c6e0fce5586._comment @@ -0,0 +1,19 @@ +[[!comment format=mdwn + username="spwhitton" + subject="reboot branch merges cleanly" + date="2016-06-21T09:20:40Z" + content=""" +Ah, very nice :) + +I reverted my GHC 6 commits and the merge with your master branch is now clean. + +Some changelog text you can use: + +- New info property Schroot.useOverlays to indicate whether you want schroots set up by propellor to use the Linux kernel's OverlayFS. +- Schroot.overlaysInTmpfs sets Schroot.useOverlays info property. +- If you have indicated that you want schroots to use OverlayFS and the current kernel does not support it, Sbuild.built will attempt to reboot into a kernel that does, or fail if it can't find one. +- Sbuild.built will no longer add duplicate `aliases=UNRELEASED,sid...` lines to more than one schroot config. It will not remove any such lines that the previous version of propellor added, though. +- Sbuild.keypairGenerated works around Debian bug #792100 by creating the directory /root/.gnupg in advance. +- Improved Sbuild module haddock. +- Ccache.hasCache now sets the setgid bit on the cache directory, as ccache requires. +"""]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_1_766444e44fe64a66d57596b1ea9d416d._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_1_766444e44fe64a66d57596b1ea9d416d._comment new file mode 100644 index 00000000..a1a72054 --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_1_766444e44fe64a66d57596b1ea9d416d._comment @@ -0,0 +1,26 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2016-06-13T22:59:56Z" + content=""" +While I've merged this, I am unsure if Reboot.toKernelNewerThan +should stop propellor from ensuring any subsequent properties. + +That works if we have: + + & toKernelNewerThan foo + & Sbuild.built + +But not if the two properties are flipped. So, doesn't it follow +that Sbuild.built is a buggy property? + +If Sbuild.built needs a particular kernel version running, +it could requires toKernelNewerThan. Then any use of Sbuild.built +would make sure the right kernel is running, rebooting into it if +necessary. + +And, if toKernelNewerThan failed due to the right kernel version not being +installed, Sbuild.built would be prevented from running. In which case, it +would be fine for propellor to continue on with ensuring other unrelated +properties. +"""]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_2_736788cdf9afc98da3dfd5a120e7978b._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_2_736788cdf9afc98da3dfd5a120e7978b._comment new file mode 100644 index 00000000..fa1048a3 --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_2_736788cdf9afc98da3dfd5a120e7978b._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 2""" + date="2016-06-13T23:13:28Z" + content=""" +readVersionMaybe was buggy; for "4.1.2" it yielded +`Just (Version {versionBranch = [4], versionTags = []})` +which is lacking anything but the major. + +I fixed it by taking the maximum of the list of all possible parses. +"""]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_3_4466bc58fd3e69938c184c817ddbb3e6._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_3_4466bc58fd3e69938c184c817ddbb3e6._comment new file mode 100644 index 00000000..4fa14683 --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_3_4466bc58fd3e69938c184c817ddbb3e6._comment @@ -0,0 +1,23 @@ +[[!comment format=mdwn + username="spwhitton" + subject="comment 3" + date="2016-06-14T03:16:18Z" + content=""" +Thanks for taking a look at my branch, and especially for fixing my inadequately-tested `readVersionMaybe`. + +`Sbuild.built` does not *require* a particular version of the kernel. It is just that the file that it generates in `/etc/schroot/chroot.d` can vary depending on the kernel version running at the time that `Sbuild.built` is first ensured. In particular, if the running kernel does not support overlayfs (as jessie's kernel doesn't), the line `union-type=overlay` will be omitted from the file in `/etc/schroot/chroot.d`. This renders `Schroot.overlaysInTmpfs` useless. + +I think it should be up to the user to apply a property like + + & Sbuild.built foo `requires` Reboot.toKernelNewerThan bar + +to individual hosts, because it depends on whether they actually care about using an overlay chroot. Perhaps on an old machine they don't intend to use overlays. In my config, I do something like this: + + & osDebian Testing \"i386\" + & Apt.stdSourcesList `onChange` (Apt.upgraded `before` Apt.cacheCleaned `before` Reboot.toKernelNewerThan \"4\") + & Sbuilt.builtFor ... + +The idea is that if I reinstall my machine from a jessie installation CD, propellor will upgrade to testing and boot to the new kernel before it builds the chroot, so I get the `union-type=overlay` line in my config. + +I could prepare a patch to add this information to the haddock of Sbuild.hs? +"""]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_3_6460a7f85249bd8b9a83f2e145a25d62._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_3_6460a7f85249bd8b9a83f2e145a25d62._comment new file mode 100644 index 00000000..3d842ac3 --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_3_6460a7f85249bd8b9a83f2e145a25d62._comment @@ -0,0 +1,29 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 3""" + date="2016-06-14T04:04:50Z" + content=""" +It might also be worth making the Sbuild properties know +whether overlays are desired. Then they could make sure to set up the +config file with the needed lines, even if the wrong kernel is running. + +I assume schroot fails to work in that configuration, so the properties +for it would fail and then the user would notice they need to add a +property to get a new enough kernel version.. + +It could be specified with another parameter to the Sbuild properties. +Or, you could add a pure Info property `useOverlays` and have the +Sbuild properties check if the Info has that set. This would also +let Schroot.overlaysInTmpfs require useOverlays and auto-enable them. + +Most of the implementation of that: + + useOverlays :: Property (HasInfo + UnixLike) + useOverlays = pureInfoProperty "use schroot overlays" (InfoVal UseOverlays) + + data UseOverlays = UseOverlays + + useOverlays :: Propellor Bool + useOverlays = isJust . fromInfoVal + <$> (askInfo :: Propellor (InfoVal UseOverlays)) +"""]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_4_b39af83b7f793013a7d63f340ee8de6d._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_4_b39af83b7f793013a7d63f340ee8de6d._comment new file mode 100644 index 00000000..148f8efb --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_4_b39af83b7f793013a7d63f340ee8de6d._comment @@ -0,0 +1,29 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 4""" + date="2016-06-14T03:41:53Z" + content=""" +When `requires` is used as in your first example, Reboot.toKernelNewerThan +does not need to throw an exception. It could just return FailedChange +and then Sbuild.builtFor wouldn't get run. + +Your second example, as written is actually buggy. If Apt.upgraded +fails for some reason, then Reboot.toKernelNewerThan never gets run, +and then Sbuilt.builtFor can still run with the wrong kernel version. + +The second example could instead be written thus: + + & osDebian Testing "i386" + & combineProperties "sbuild setup" + ( props + & Apt.stdSourcesList `onChange` (Apt.upgraded `before` Apt.cacheCleaned `before` Reboot.toKernelNewerThan "4") + & Sbuilt.builtFor ... + ) + +Then if any part of the upgrade fails the following properties don't run +thanks to `combineProperties`. And here too Reboot.toKernelNewerThan does +not need to thow an exception. + +So, I'm not seeing any good use cases for it throwing an exception in these +examples. +"""]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_6_c2b043ecea1524e4d5743196fc0d191c._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_6_c2b043ecea1524e4d5743196fc0d191c._comment new file mode 100644 index 00000000..05ca43ae --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_6_c2b043ecea1524e4d5743196fc0d191c._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="spwhitton" + subject="comment 6" + date="2016-06-16T06:30:04Z" + content=""" +I like the idea of a `useOverlays` info property. It is better, and more in the spirit of propellor, to have the choice explicit, rather than implicitly relying on the behaviour of certain shell commands in certain conditions (relying on sbuild-createchroot(1) to create the config file in /etc/schroot/chroot.d is the thing I like least about Sbuild.hs, though it's necessary for achieving the goal of having a totally standard Debian sbuild setup). + +Before I implement this, I have a couple of questions: + +1. In the case where `Reboot.toKernelNewerThan` finds a satisfactory kernel to reboot to, what do you think about the choice of rebooting immediately or at the end of the current propellor run? If every property that needs the newer kernel `requires` it, it would mean that other properties that don't need the newer kernel get ensured sooner. Not sure whether this is actually an advantage, but it might encourage using `requires` instead of relying on implicit ordering. + +2. You suggest relying on schroot(1) and sbuild-createchroot(1) failing if `union-type=overlay` is present in the config file but the kernel doesn't support overlays. I'd prefer to go further and have the sbuild properties conditionally `requires` `Reboot.toKernelNewerThan` if the info property is set. That way, we can be confident that we'll never get an inconsistent state out of the sbuild properties. Does this sound sensible? +"""]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_7_c556c4905ff4840e148bdd51a8dc1e53._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_7_c556c4905ff4840e148bdd51a8dc1e53._comment new file mode 100644 index 00000000..5898e0a5 --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_7_c556c4905ff4840e148bdd51a8dc1e53._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 7""" + date="2016-06-17T01:21:08Z" + content=""" +If Reboot.toKernelNewerThan doesn't reboot right away, then +when a property `requires` it, the property's code is not +guaranteed to run under the new kernel. +So, an immediate reboot seems to make sense. + +Making the sbuild properties automatically include +Reboot.toKernelNewerThan seems reasonable. +"""]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_8_b4b2bd5741fbc7759d85d826dc1f9f7f._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_8_b4b2bd5741fbc7759d85d826dc1f9f7f._comment new file mode 100644 index 00000000..36556924 --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_8_b4b2bd5741fbc7759d85d826dc1f9f7f._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="spwhitton" + subject="comment 8" + date="2016-06-19T12:31:40Z" + content=""" +Please consider merging my new `reboot` branch which addresses the discussion we've had. + +I also included some other improvements to `Sbuild.hs`, a bug fix in `Ccache.hs` and some GHC 7.6 compatibility fixes. With one exception,[1] I think that the changes are sufficiently self-explanatory that `git diff master..spwhitton/reboot` will be enough for you to review the branch. If not, I will happily split the commits into several branches. + +[1] I changed the haddocks on some functions in Sbuild.hs so that they will be properly hyperlinked, and did some other documentation rearrangements. +"""]] diff --git a/doc/todo/merge_request:_changes_to_Reboot.hs/comment_9_233140189ee7ffebad687db76dfe2258._comment b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_9_233140189ee7ffebad687db76dfe2258._comment new file mode 100644 index 00000000..1afbef11 --- /dev/null +++ b/doc/todo/merge_request:_changes_to_Reboot.hs/comment_9_233140189ee7ffebad687db76dfe2258._comment @@ -0,0 +1,22 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 9""" + date="2016-06-20T17:56:25Z" + content=""" +Félix sent some patches today fixing compiling Propellor.Exception on old +ghc, which overlap with part of your patch. You addressed the same problem +in different ways. Since I already merged his (more extensive I think) +fixes for that, your branch will need to be updated. + +The only thing I caught during review is that the documentation for +useOverlays says that the property has to be added before +Sbuild.builtFor, but actually info-setting properties +set info before any properties run, so can safely appear after properties +that use the info they set! + +(I'm not sure if overlaysInTmpfs can safely come after +Sbuild.builtFor, but if it cannot it's not due to setting useOverlays.) + +Also, it would be good to have some lines to add to the changelog +about the sbuild changes. +"""]] diff --git a/joeyconfig.hs b/joeyconfig.hs index 98c565c5..364882b2 100644 --- a/joeyconfig.hs +++ b/joeyconfig.hs @@ -45,7 +45,7 @@ main = defaultMain hosts -- / \___-=O`/|O`/__| (____.' hosts :: [Host] -- * \ | | '--------' hosts = -- (o) ` [ darkstar - , gnu + , gnu , clam , mayfly , oyster @@ -60,7 +60,7 @@ hosts = -- (o) ` testvm :: Host testvm = host "testvm.kitenet.net" $ props - & osDebian Unstable "amd64" + & osDebian Unstable X86_64 & OS.cleanInstallOnce (OS.Confirmed "testvm.kitenet.net") `onChange` postinstall & Hostname.sane @@ -98,7 +98,7 @@ darkstar = host "darkstar.kitenet.net" $ props ] where c d = Chroot.debootstrapped mempty d $ props - & osDebian Unstable "amd64" + & osDebian Unstable X86_64 & Hostname.setTo "demo" & Apt.installed ["linux-image-amd64"] & User "root" `User.hasInsecurePassword` "root" @@ -112,7 +112,7 @@ gnu = host "gnu.kitenet.net" $ props clam :: Host clam = host "clam.kitenet.net" $ props - & standardSystem Unstable "amd64" + & standardSystem Unstable X86_64 ["Unreliable server. Anything here may be lost at any time!" ] & ipv4 "167.88.41.194" @@ -145,7 +145,7 @@ clam = host "clam.kitenet.net" $ props mayfly :: Host mayfly = host "mayfly.kitenet.net" $ props - & standardSystem (Stable "jessie") "amd64" + & standardSystem (Stable "jessie") X86_64 [ "Scratch VM. Contents can change at any time!" ] & ipv4 "167.88.36.193" @@ -161,7 +161,7 @@ mayfly = host "mayfly.kitenet.net" $ props oyster :: Host oyster = host "oyster.kitenet.net" $ props - & standardSystem Unstable "amd64" + & standardSystem Unstable X86_64 [ "Unreliable server. Anything here may be lost at any time!" ] & ipv4 "104.167.117.109" @@ -185,7 +185,7 @@ oyster = host "oyster.kitenet.net" $ props orca :: Host orca = host "orca.kitenet.net" $ props - & standardSystem Unstable "amd64" [ "Main git-annex build box." ] + & standardSystem Unstable X86_64 [ "Main git-annex build box." ] & ipv4 "138.38.108.179" & Apt.unattendedUpgrades @@ -195,19 +195,19 @@ orca = host "orca.kitenet.net" $ props & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer GitAnnexBuilder.standardAutoBuilder - Unstable "amd64" Nothing (Cron.Times "15 * * * *") "2h") + Unstable X86_64 Nothing (Cron.Times "15 * * * *") "2h") & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer GitAnnexBuilder.standardAutoBuilder - Unstable "i386" Nothing (Cron.Times "30 * * * *") "2h") + Unstable X86_32 Nothing (Cron.Times "30 * * * *") "2h") & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer GitAnnexBuilder.stackAutoBuilder - (Stable "jessie") "i386" (Just "ancient") (Cron.Times "45 * * * *") "2h") + (Stable "jessie") X86_32 (Just "ancient") (Cron.Times "45 * * * *") "2h") & Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer (Cron.Times "1 1 * * *") "3h") honeybee :: Host honeybee = host "honeybee.kitenet.net" $ props - & standardSystem Testing "armhf" [ "Arm git-annex build box." ] + & standardSystem Testing ARMHF [ "Arm git-annex build box." ] -- I have to travel to get console access, so no automatic -- upgrades, and try to be robust. @@ -234,14 +234,14 @@ honeybee = host "honeybee.kitenet.net" $ props & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer GitAnnexBuilder.armAutoBuilder - Unstable "armel" Nothing Cron.Daily "22h") + Unstable ARMEL Nothing Cron.Daily "22h") -- This is not a complete description of kite, since it's a -- multiuser system with eg, user passwords that are not deployed -- with propellor. kite :: Host kite = host "kite.kitenet.net" $ props - & standardSystemUnhardened Testing "amd64" [ "Welcome to kite!" ] + & standardSystemUnhardened Testing X86_64 [ "Welcome to kite!" ] & ipv4 "66.228.36.95" & ipv6 "2600:3c03::f03c:91ff:fe73:b0d2" & alias "kitenet.net" @@ -356,7 +356,7 @@ kite = host "kite.kitenet.net" $ props elephant :: Host elephant = host "elephant.kitenet.net" $ props - & standardSystem Unstable "amd64" + & standardSystem Unstable X86_64 [ "Storage, big data, and backups, omnomnom!" , "(Encrypt all data stored here.)" ] @@ -457,7 +457,7 @@ iabak :: Host iabak = host "iabak.archiveteam.org" $ props & ipv4 "124.6.40.227" & Hostname.sane - & osDebian Testing "amd64" + & osDebian Testing X86_64 & Systemd.persistentJournal & Cron.runPropellor (Cron.Times "30 * * * *") & Apt.stdSourcesList `onChange` Apt.upgrade @@ -539,7 +539,7 @@ type Motd = [String] -- This is my standard system setup. standardSystem :: DebianSuite -> Architecture -> Motd -> Property (HasInfo + Debian) -standardSystem suite arch motd = +standardSystem suite arch motd = standardSystemUnhardened suite arch motd `before` Ssh.noPasswords @@ -571,7 +571,7 @@ standardSystemUnhardened suite arch motd = propertyList "standard system" $ prop -- This is my standard container setup, Featuring automatic upgrades. standardContainer :: DebianSuite -> Property (HasInfo + Debian) standardContainer suite = propertyList "standard container" $ props - & osDebian suite "amd64" + & osDebian suite X86_64 & Apt.stdSourcesList `onChange` Apt.upgrade & Apt.unattendedUpgrades & Apt.cacheCleaned diff --git a/propellor.cabal b/propellor.cabal index 38ed32e7..a4f5f38c 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 3.0.5 +Version: 3.1.0 Cabal-Version: >= 1.8 License: BSD2 Maintainer: Joey Hess <id@joeyh.name> @@ -98,6 +98,7 @@ Library Propellor.Property.Docker Propellor.Property.Fail2Ban Propellor.Property.File + Propellor.Property.Firejail Propellor.Property.Firewall Propellor.Property.FreeBSD Propellor.Property.FreeBSD.Pkg @@ -144,6 +145,7 @@ Library Propellor.Property.ZFS.Properties Propellor.Property.HostingProvider.CloudAtCost Propellor.Property.HostingProvider.DigitalOcean + Propellor.Property.HostingProvider.Exoscale Propellor.Property.HostingProvider.Linode Propellor.Property.SiteSpecific.GitHome Propellor.Property.SiteSpecific.JoeySites @@ -169,6 +171,7 @@ Library Propellor.Types.Docker Propellor.Types.Dns Propellor.Types.Empty + Propellor.Types.Exception Propellor.Types.Info Propellor.Types.MetaTypes Propellor.Types.OS diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index 29175a67..2c8fa95a 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -60,7 +60,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) where osinstall = case msys of Just (System (FreeBSD _) _) -> map pkginstall fbsddeps - Just (System (Debian _) _) -> useapt + Just (System (Debian _ _) _) -> useapt Just (System (Buntish _) _) -> useapt -- assume a debian derived system when not specified Nothing -> useapt @@ -115,7 +115,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) installGitCommand :: Maybe System -> ShellCommand installGitCommand msys = case msys of - (Just (System (Debian _) _)) -> use apt + (Just (System (Debian _ _) _)) -> use apt (Just (System (Buntish _) _)) -> use apt (Just (System (FreeBSD _) _)) -> use [ "ASSUME_ALWAYS_YES=yes pkg update" @@ -125,7 +125,7 @@ installGitCommand msys = case msys of Nothing -> use apt where use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi" - apt = + apt = [ "apt-get update" , "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git" ] @@ -177,7 +177,7 @@ cabalBuild msys = do ( return True , case msys of Nothing -> return False - Just sys -> + Just sys -> boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))] <&&> cabal ["configure"] ) diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs index f32b52a4..c73420b0 100644 --- a/src/Propellor/DotDir.hs +++ b/src/Propellor/DotDir.hs @@ -166,7 +166,7 @@ setup = do buildPropellor Nothing sayLn "" sayLn "Great! Propellor is bootstrapped." - + section sayLn "Propellor can use gpg to encrypt private data about the systems it manages," sayLn "and to sign git commits." @@ -273,7 +273,7 @@ minimalConfig = do , " Extensions: TypeOperators" , " Build-Depends: propellor >= 3.0, base >= 3" ] - configcontent = + configcontent = [ "-- This is the main configuration file for Propellor, and is used to build" , "-- the propellor program. https://propellor.branchable.com/" , "" @@ -295,7 +295,7 @@ minimalConfig = do , "-- An example host." , "mybox :: Host" , "mybox = host \"mybox.example.com\" $ props" - , " & osDebian Unstable \"amd64\"" + , " & osDebian Unstable X86_64" , " & Apt.stdSourcesList" , " & Apt.unattendedUpgrades" , " & Apt.installed [\"etckeeper\"]" @@ -308,13 +308,16 @@ minimalConfig = do stackcontent = -- This should be the same resolver version in propellor's -- own stack.yaml - [ "resolver: lts-5.10" + [ "resolver: " ++ stackResolver , "packages:" , "- '.'" , "extra-deps:" , "- propellor-" ++ showVersion Package.version ] +stackResolver :: String +stackResolver = "lts-5.10" + fullClone :: IO Result fullClone = do d <- dotPropellor @@ -351,7 +354,7 @@ checkRepoUpToDate :: IO () checkRepoUpToDate = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do headrev <- takeWhile (/= '\n') <$> readFile disthead changeWorkingDirectory =<< dotPropellor - headknown <- catchMaybeIO $ + headknown <- catchMaybeIO $ withQuietOutput createProcessSuccess $ proc "git" ["log", headrev] if (headknown == Nothing) @@ -394,19 +397,19 @@ setupUpstreamMaster newref = do let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo cleantmprepo git ["clone", "--quiet", ".", tmprepo] - + changeWorkingDirectory tmprepo git ["fetch", distrepo, "--quiet"] git ["reset", "--hard", oldref, "--quiet"] git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"] - + void $ fetchUpstreamBranch tmprepo cleantmprepo warnoutofdate True getoldrev = takeWhile (/= '\n') <$> readProcess "git" ["show-ref", upstreambranch, "--hash"] - + git = run "git" run cmd ps = unlessM (boolSystem cmd (map Param ps)) $ error $ "Failed to run " ++ cmd ++ " " ++ show ps diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs index 2b38af0c..463402e4 100644 --- a/src/Propellor/Exception.hs +++ b/src/Propellor/Exception.hs @@ -1,18 +1,38 @@ -{-# LANGUAGE PackageImports #-} +{-# LANGUAGE CPP, ScopedTypeVariables #-} module Propellor.Exception where import Propellor.Types +import Propellor.Types.Exception import Propellor.Message import Utility.Exception -import Control.Exception (IOException) +import Control.Exception (AsyncException) +#if MIN_VERSION_base(4,7,0) +import Control.Exception (SomeAsyncException) +#endif +import Control.Monad.Catch +import Control.Monad.IO.Class (MonadIO) +import Prelude --- | Catches IO exceptions and returns FailedChange. -catchPropellor :: Propellor Result -> Propellor Result +-- | Catches all exceptions (except for `StopPropellorException` and +-- `AsyncException` and `SomeAsyncException`) and returns FailedChange. +catchPropellor :: (MonadIO m, MonadCatch m) => m Result -> m Result catchPropellor a = either err return =<< tryPropellor a where err e = warningMessage (show e) >> return FailedChange -tryPropellor :: Propellor a -> Propellor (Either IOException a) -tryPropellor = try +catchPropellor' :: MonadCatch m => m a -> (SomeException -> m a) -> m a +catchPropellor' a onerr = a `catches` + [ Handler (\ (e :: AsyncException) -> throwM e) +#if MIN_VERSION_base(4,7,0) + , Handler (\ (e :: SomeAsyncException) -> throwM e) +#endif + , Handler (\ (e :: StopPropellorException) -> throwM e) + , Handler (\ (e :: SomeException) -> onerr e) + ] + +-- | Catches all exceptions (except for `StopPropellorException` and +-- `AsyncException`). +tryPropellor :: MonadCatch m => m a -> m (Either SomeException a) +tryPropellor a = (return . Right =<< a) `catchPropellor'` (return . Left) diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs index b87369c3..e9218291 100644 --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -77,9 +77,15 @@ askInfo = asks (fromInfo . hostInfo) -- It also lets the type checker know that all the properties of the -- host must support Debian. -- --- > & osDebian (Stable "jessie") "amd64" +-- > & osDebian (Stable "jessie") X86_64 osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian) -osDebian suite arch = tightenTargets $ os (System (Debian suite) arch) +osDebian = osDebian' Linux + +-- Use to specify a different `DebianKernel` than the default `Linux` +-- +-- > & osDebian' KFreeBSD (Stable "jessie") X86_64 +osDebian' :: DebianKernel -> DebianSuite -> Architecture -> Property (HasInfo + Debian) +osDebian' kernel suite arch = tightenTargets $ os (System (Debian kernel suite) arch) -- | Specifies that a host's operating system is a well-known Debian -- derivative founded by a space tourist. diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index 32625e6a..f728e143 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -13,6 +13,7 @@ module Propellor.Message ( warningMessage, infoMessage, errorMessage, + stopPropellorMessage, processChainOutput, messagesDone, createProcessConcurrent, @@ -29,6 +30,7 @@ import Control.Applicative import Prelude import Propellor.Types +import Propellor.Types.Exception import Utility.PartialPrelude import Utility.Monad import Utility.Exception @@ -105,11 +107,29 @@ warningMessage s = liftIO $ infoMessage :: MonadIO m => [String] -> m () infoMessage ls = liftIO $ outputConcurrent $ concatMap (++ "\n") ls +-- | Displays the error message in red, and throws an exception. +-- +-- When used inside a property, the exception will make the current +-- property fail. Propellor will continue to the next property. errorMessage :: MonadIO m => String -> m a errorMessage s = liftIO $ do outputConcurrent =<< colorLine Vivid Red ("** error: " ++ s) + -- Normally this exception gets caught and is not displayed, + -- and propellor continues. So it's only displayed if not + -- caught, and so we say, cannot continue. error "Cannot continue!" +-- | Like `errorMessage`, but throws a `StopPropellorException`, +-- preventing propellor from continuing to the next property. +-- +-- Think twice before using this. Is the problem so bad that propellor +-- cannot try to ensure other properties? If not, use `errorMessage` +-- instead. +stopPropellorMessage :: MonadIO m => String -> m a +stopPropellorMessage s = liftIO $ do + outputConcurrent =<< colorLine Vivid Red ("** fatal error: " ++ s) + throwM $ StopPropellorException "Cannot continue!" + colorLine :: ColorIntensity -> Color -> String -> IO String colorLine intensity color msg = concat <$> sequence [ whenConsole $ diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index af36ed58..7ee9397e 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -16,6 +16,7 @@ module Propellor.Property ( , check , fallback , revert + , applyToList -- * Property descriptions , describe , (==>) @@ -53,6 +54,7 @@ import System.Posix.Files import qualified Data.Hash.MD5 as MD5 import Data.List import Control.Applicative +import Data.Foldable hiding (and, elem) import Prelude import Propellor.Types @@ -81,7 +83,7 @@ flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do go _ _ True = return NoChange go satisfy flagfile False = do r <- satisfy - when (r == MadeChange) $ liftIO $ + when (r == MadeChange) $ liftIO $ unlessM (doesFileExist flagfile) $ do createDirectoryIfMissing True (takeDirectory flagfile) writeFile flagfile "" @@ -277,7 +279,7 @@ pickOS , SingI c -- Would be nice to have this constraint, but -- union will not generate metatypes lists with the same - -- order of OS's as is used everywhere else. So, + -- order of OS's as is used everywhere else. So, -- would need a type-level sort. --, Union a b ~ c ) @@ -295,7 +297,7 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b] then getSatisfy b else unsupportedOS' matching Nothing _ = False - matching (Just o) p = + matching (Just o) p = Targeting (systemToTargetOS o) `elem` fromSing (proptype p) @@ -341,6 +343,14 @@ unsupportedOS' = go =<< getOS revert :: RevertableProperty setup undo -> RevertableProperty undo setup revert (RevertableProperty p1 p2) = RevertableProperty p2 p1 +-- | Apply a property to each element of a list. +applyToList + :: (Foldable t, Functor t, IsProp p, Combines p p, p ~ CombinedType p p) + => (b -> p) + -> t b + -> p +prop `applyToList` xs = Data.Foldable.foldr1 before $ prop <$> xs + makeChange :: IO () -> Propellor Result makeChange a = liftIO a >> return MadeChange diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 5e185a0e..196fb345 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -82,7 +82,7 @@ securityUpdates suite -- kernel.org. stdSourcesList :: Property Debian stdSourcesList = withOS "standard sources.list" $ \w o -> case o of - (Just (System (Debian suite) _)) -> + (Just (System (Debian _ suite) _)) -> ensureProperty w $ stdSourcesListFor suite _ -> unsupportedOS' @@ -154,14 +154,14 @@ installed :: [Package] -> Property DebianLike installed = installed' ["-y"] installed' :: [String] -> [Package] -> Property DebianLike -installed' params ps = robustly $ check (isInstallable ps) go +installed' params ps = robustly $ check (not <$> isInstalled' ps) go `describe` unwords ("apt installed":ps) where go = runApt (params ++ ["install"] ++ ps) installedBackport :: [Package] -> Property Debian installedBackport ps = withOS desc $ \w o -> case o of - (Just (System (Debian suite) _)) -> case backportSuite suite of + (Just (System (Debian _ suite) _)) -> case backportSuite suite of Nothing -> unsupportedOS' Just bs -> ensureProperty w $ runApt (["install", "-t", bs, "-y"] ++ ps) @@ -175,7 +175,8 @@ installedMin :: [Package] -> Property DebianLike installedMin = installed' ["--no-install-recommends", "-y"] removed :: [Package] -> Property DebianLike -removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps)) +removed ps = check (any (== IsInstalled) <$> getInstallStatus ps) + (runApt (["-y", "remove"] ++ ps)) `describe` unwords ("apt removed":ps) buildDep :: [Package] -> Property DebianLike @@ -200,24 +201,24 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv robustly :: Property DebianLike -> Property DebianLike robustly p = p `fallback` (update `before` p) -isInstallable :: [Package] -> IO Bool -isInstallable ps = do - l <- isInstalled' ps - return $ elem False l && not (null l) - isInstalled :: Package -> IO Bool -isInstalled p = (== [True]) <$> isInstalled' [p] - --- | Note that the order of the returned list will not always --- correspond to the order of the input list. The number of items may --- even vary. If apt does not know about a package at all, it will not --- be included in the result list. -isInstalled' :: [Package] -> IO [Bool] -isInstalled' ps = (mapMaybe parse . lines) <$> policy +isInstalled p = isInstalled' [p] + +isInstalled' :: [Package] -> IO Bool +isInstalled' ps = all (== IsInstalled) <$> getInstallStatus ps + +data InstallStatus = IsInstalled | NotInstalled + deriving (Show, Eq) + +{- Returns the InstallStatus of packages that are installed + - or known and not installed. If a package is not known at all to apt + - or dpkg, it is not included in the list. -} +getInstallStatus :: [Package] -> IO [InstallStatus] +getInstallStatus ps = mapMaybe parse . lines <$> policy where parse l - | "Installed: (none)" `isInfixOf` l = Just False - | "Installed: " `isInfixOf` l = Just True + | "Installed: (none)" `isInfixOf` l = Just NotInstalled + | "Installed: " `isInfixOf` l = Just IsInstalled | otherwise = Nothing policy = do environ <- addEntry "LANG" "C" <$> getEnvironment @@ -257,7 +258,7 @@ unattendedUpgrades = enable <!> disable enableupgrading = withOS "unattended upgrades configured" $ \w o -> case o of -- the package defaults to only upgrading stable - (Just (System (Debian suite) _)) + (Just (System (Debian _ suite) _)) | not (isStable suite) -> ensureProperty w $ unattendedconfig `File.containsLine` diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs index f5842115..16030562 100644 --- a/src/Propellor/Property/Borg.hs +++ b/src/Propellor/Property/Borg.hs @@ -23,7 +23,7 @@ type BorgRepo = FilePath installed :: Property DebianLike installed = withOS desc $ \w o -> case o of - (Just (System (Debian (Stable "jessie")) _)) -> ensureProperty w $ + (Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $ Apt.installedBackport ["borgbackup"] _ -> ensureProperty w $ Apt.installed ["borgbackup"] diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index f2246fe1..c0b8d539 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -66,8 +66,7 @@ path `hasLimits` limit = go `requires` installed cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)] `changesFileContent` (path </> "ccache.conf") | otherwise = property "couldn't parse ccache limits" $ - sequence_ (errorMessage <$> errors) - >> return FailedChange + errorMessage $ unlines errors params = limitToParams limit (errors, params') = partitionEithers params @@ -96,14 +95,40 @@ group@(Group g) `hasCache` limit = (make `requires` installed) <!> delete & File.dirExists path & File.ownerGroup path (User "root") group & File.mode path (combineModes $ - readModes ++ executeModes - ++ [ownerWriteMode, groupWriteMode]) + readModes ++ executeModes ++ + [ ownerWriteMode + , groupWriteMode + , setGroupIDMode + ]) `onChange` fixSetgidBit + -- here, we use onChange to catch upgrades from + -- 3.0.5 where the setGroupIDMode line was not + -- present & hasLimits path limit delete = check (doesDirectoryExist path) $ cmdProperty "rm" ["-r", path] `assume` MadeChange `describe` ("ccache for " ++ g ++ " does not exist") + -- Here we deal with a bug in Propellor 3.0.5. If the ccache was + -- created with that version, it will not have the setgid bit set. That + -- means its subdirectories won't have inherited the setgid bit, and + -- then the files in those directories won't be owned by group sbuild. + -- This breaks ccache. + fixSetgidBit :: Property UnixLike + fixSetgidBit = + (cmdProperty "find" + [ path + , "-type", "d" + , "-exec", "chmod", "g+s" + , "{}", "+" + ] `assume` MadeChange) + `before` + (cmdProperty "chown" + [ "-R" + , "root:" ++ g + , path + ] `assume` MadeChange) + path = "/var/cache/ccache-" ++ g installed :: Property DebianLike diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 09047ce5..cb693a73 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -91,7 +91,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 (Debian _ _) _)) -> Right $ debootstrap s (Just s@(System (Buntish _) _)) -> Right $ debootstrap s (Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap." Nothing -> Left "Cannot debootstrap; OS not specified" @@ -105,7 +105,7 @@ instance ChrootBootstrapper Debootstrapped where -- to bootstrap. -- -- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props --- > & osDebian Unstable "amd64" +-- > & osDebian Unstable X86_64 -- > & Apt.installed ["ghc", "haskell-platform"] -- > & ... debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Props metatypes -> Chroot diff --git a/src/Propellor/Property/ConfFile.hs b/src/Propellor/Property/ConfFile.hs index 270e04f1..b49c626e 100644 --- a/src/Propellor/Property/ConfFile.hs +++ b/src/Propellor/Property/ConfFile.hs @@ -9,6 +9,7 @@ module Propellor.Property.ConfFile ( IniSection, IniKey, containsIniSetting, + hasIniSection, lacksIniSection, ) where @@ -24,7 +25,7 @@ type SectionStart = Line -> Bool type SectionPast = Line -> Bool -- | run on all lines in the section, including the SectionStart line; -- can add, delete, and modify lines, or even delete entire section -type AdjustSection = [Line] -> [Line] +type AdjustSection = [Line] -> [Line] -- | if SectionStart does not find the section in the file, this is used to -- insert the section somewhere within it type InsertSection = [Line] -> [Line] @@ -43,7 +44,7 @@ adjustSection desc start past adjust insert = fileProperty desc go go ls = let (pre, wanted, post) = foldl' find ([], [], []) ls in if null wanted then insert ls - else pre ++ (adjust wanted) ++ post + else pre ++ adjust wanted ++ post find (pre, wanted, post) l | null wanted && null post && (not . start) l = (pre ++ [l], wanted, post) @@ -78,8 +79,7 @@ adjustIniSection desc header = -- | Ensures that a .ini file exists and contains a section -- with a key=value setting. containsIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property UnixLike -containsIniSetting f (header, key, value) = - adjustIniSection +containsIniSetting f (header, key, value) = adjustIniSection (f ++ " section [" ++ header ++ "] contains " ++ key ++ "=" ++ value) header go @@ -89,13 +89,26 @@ containsIniSetting f (header, key, value) = confheader = iniHeader header confline = key ++ "=" ++ value go [] = [confline] - go (l:ls) = if isKeyVal l then confline : ls else l : (go ls) + go (l:ls) = if isKeyVal l then confline : ls else l : go ls isKeyVal x = (filter (/= ' ') . takeWhile (/= '=')) x `elem` [key, '#':key] +-- | Ensures that a .ini file exists and contains a section +-- with a given key=value list of settings. +hasIniSection :: FilePath -> IniSection -> [(IniKey, String)] -> Property UnixLike +hasIniSection f header keyvalues = adjustIniSection + ("set " ++ f ++ " section [" ++ header ++ "]") + header + go + (++ confheader : conflines) -- add missing section at end + f + where + confheader = iniHeader header + conflines = map (\(key, value) -> key ++ "=" ++ value) keyvalues + go _ = confheader : conflines + -- | Ensures that a .ini file does not contain the specified section. lacksIniSection :: FilePath -> IniSection -> Property UnixLike -lacksIniSection f header = - adjustIniSection +lacksIniSection f header = adjustIniSection (f ++ " lacks section [" ++ header ++ "]") header (const []) -- remove all lines of section diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs index b86d8e0b..d8a9c423 100644 --- a/src/Propellor/Property/DebianMirror.hs +++ b/src/Propellor/Property/DebianMirror.hs @@ -141,7 +141,7 @@ mirror mirror' = propertyList ("Debian mirror " ++ dir) $ props rsyncextraarg res = intercalate "," $ map showRsyncExtra res args = [ "--dist" , suitearg - , "--arch", architecturearg $ _debianMirrorArchitectures mirror' + , "--arch", architecturearg $ map architectureToDebianArchString (_debianMirrorArchitectures mirror') , "--section", intercalate "," $ _debianMirrorSections mirror' , "--limit-priority", "\"" ++ priorityRegex (_debianMirrorPriorities mirror') ++ "\"" ] diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index 87f30776..69ac036a 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -67,7 +67,7 @@ built' installprop target system@(System _ arch) config = Nothing -> errorMessage $ "don't know how to debootstrap " ++ show system Just s -> pure s let params = toParams config ++ - [ Param $ "--arch=" ++ arch + [ Param $ "--arch=" ++ architectureToDebianArchString arch , Param suite , Param target ] @@ -90,7 +90,7 @@ built' installprop target system@(System _ arch) config = ) extractSuite :: System -> Maybe String -extractSuite (System (Debian s) _) = Just $ Apt.showSuite s +extractSuite (System (Debian _ s) _) = Just $ Apt.showSuite s extractSuite (System (Buntish r) _) = Just r extractSuite (System (FreeBSD _) _) = Nothing diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index afeaa287..06dfa69c 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -1,4 +1,4 @@ --- | Disk image generation. +-- | Disk image generation. -- -- This module is designed to be imported unqualified. @@ -56,7 +56,7 @@ type DiskImage = FilePath -- > import Propellor.Property.DiskImage -- -- > let chroot d = Chroot.debootstrapped mempty d --- > & osDebian Unstable "amd64" +-- > & osDebian Unstable X86_64 -- > & Apt.installed ["linux-image-amd64"] -- > & User.hasPassword (User "root") -- > & User.accountFor (User "demo") @@ -91,7 +91,7 @@ imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization - imageRebuilt = imageBuilt' True imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux -imageBuilt' rebuild img mkchroot tabletype final partspec = +imageBuilt' rebuild img mkchroot tabletype final partspec = imageBuiltFrom img chrootdir tabletype final partspec `requires` Chroot.provisioned chroot `requires` (cleanrebuild <!> (doNothing :: Property UnixLike)) @@ -132,7 +132,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg -- unmount helper filesystems such as proc from the chroot -- before getting sizes liftIO $ unmountBelow chrootdir - szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize + szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize <$> liftIO (dirSizes chrootdir) let calcsz mnts = maybe defSz fudge . getMountSz szm mnts -- tie the knot! @@ -151,7 +151,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg rmimg = File.notPresent img partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux -partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w -> +partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w -> mconcat $ zipWith3 (go w) mnts mntopts devs where desc = "partitions populated from " ++ chrootdir @@ -165,11 +165,11 @@ partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w -> syncDirFiltered (filtersfor mnt) (chrootdir ++ mnt) tmpdir else return FailedChange - filtersfor mnt = + filtersfor mnt = let childmnts = map (drop (length (dropTrailingPathSeparator mnt))) $ filter (\m -> m /= mnt && addTrailingPathSeparator mnt `isPrefixOf` m) (catMaybes mnts) - in concatMap (\m -> + in concatMap (\m -> -- Include the child mount point, but exclude its contents. [ Include (Pattern m) , Exclude (filesUnder m) @@ -185,8 +185,8 @@ fitChrootSize tt l basesizes = (mounts, mountopts, parttable) (mounts, mountopts, sizers) = unzip3 l parttable = PartTable tt (zipWith id sizers basesizes) --- | Generates a map of the sizes of the contents of --- every directory in a filesystem tree. +-- | Generates a map of the sizes of the contents of +-- every directory in a filesystem tree. -- -- (Hard links are counted multiple times for simplicity) -- @@ -201,7 +201,7 @@ dirSizes top = go M.empty top [top] if isDirectory s then do subm <- go M.empty i =<< dirContents i - let sz' = M.foldr' (+) sz + let sz' = M.foldr' (+) sz (M.filterWithKey (const . subdirof i) subm) go (M.insertWith (+) i sz' (M.union m subm)) dir is else go (M.insertWith (+) dir sz m) dir is @@ -209,13 +209,13 @@ dirSizes top = go M.empty top [top] getMountSz :: (M.Map FilePath PartSize) -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize getMountSz _ _ Nothing = Nothing -getMountSz szm l (Just mntpt) = +getMountSz szm l (Just mntpt) = fmap (`reducePartSize` childsz) (M.lookup mntpt szm) where childsz = mconcat $ mapMaybe (getMountSz szm l) (filter (isChild mntpt) l) -- | Ensures that a disk image file of the specified size exists. --- +-- -- If the file doesn't exist, or is too small, creates a new one, full of 0's. -- -- If the file is too large, truncates it down to the specified size. @@ -223,7 +223,7 @@ imageExists :: FilePath -> ByteSize -> Property Linux imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do ms <- catchMaybeIO $ getFileStatus img case ms of - Just s + Just s | toInteger (fileSize s) == toInteger sz -> return NoChange | toInteger (fileSize s) > toInteger sz -> do setFileSize img (fromInteger sz) @@ -239,15 +239,15 @@ imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do -- with its populated partition tree mounted in the provided -- location from the provided loop devices. This will typically -- take care of installing the boot loader to the image. --- +-- -- It's ok if the second property leaves additional things mounted -- in the partition tree. type Finalization = (Property Linux, (FilePath -> [LoopDev] -> Property Linux)) imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux -imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) = +imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) = property' "disk image finalized" $ \w -> - withTmpDir "mnt" $ \top -> + withTmpDir "mnt" $ \top -> go w top `finally` liftIO (unmountall top) where go w top = do @@ -255,12 +255,12 @@ imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) = liftIO $ writefstab top liftIO $ allowservices top ensureProperty w $ final top devs - + -- Ordered lexographically by mount point, so / comes before /usr -- comes before /usr/local orderedmntsdevs :: [(Maybe MountPoint, (MountOpts, LoopDev))] orderedmntsdevs = sortBy (compare `on` fst) $ zip mnts (zip mntopts devs) - + swaps = map (SwapPartition . partitionLoopDev . snd) $ filter ((== LinuxSwap) . partFs . fst) $ zip parts devs @@ -276,7 +276,7 @@ imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) = unmountall top = do unmountBelow top umountLazy top - + writefstab top = do let fstab = top ++ "/etc/fstab" old <- catchDefaultIO [] $ filter (not . unconfigured) . lines diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index e072fcaa..95fc6f81 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE FlexibleInstances #-} + module Propellor.Property.File where import Propellor.Base import Utility.FileMode +import qualified Data.ByteString.Lazy as L import System.Posix.Files import System.Exit @@ -14,10 +17,28 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f) (\_oldcontent -> newcontent) f +-- | Ensures that a line is present in a file, adding it to the end if not. +containsLine :: FilePath -> Line -> Property UnixLike +f `containsLine` l = f `containsLines` [l] + +containsLines :: FilePath -> [Line] -> Property UnixLike +f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f + where + go content = content ++ filter (`notElem` content) ls + +-- | Ensures that a line is not present in a file. +-- Note that the file is ensured to exist, so if it doesn't, an empty +-- file will be written. +lacksLine :: FilePath -> Line -> Property UnixLike +f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f + +lacksLines :: FilePath -> [Line] -> Property UnixLike +f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f + -- | Replaces all the content of a file, ensuring that its modes do not -- allow it to be read or written by anyone other than the current user hasContentProtected :: FilePath -> [Line] -> Property UnixLike -f `hasContentProtected` newcontent = fileProperty' writeFileProtected +f `hasContentProtected` newcontent = fileProperty' ProtectedWrite ("replace " ++ f) (\_oldcontent -> newcontent) f @@ -29,9 +50,9 @@ hasPrivContent :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike) hasPrivContent f = hasPrivContentFrom (PrivDataSourceFile (PrivFile f) f) f -- | Like hasPrivContent, but allows specifying a source --- for PrivData, rather than using PrivDataSourceFile . +-- for PrivData, rather than using `PrivDataSourceFile`. hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike) -hasPrivContentFrom = hasPrivContent' writeFileProtected +hasPrivContentFrom = hasPrivContent' ProtectedWrite -- | Leaves the file at its default or current mode, -- allowing "private" data to be read. @@ -41,68 +62,30 @@ hasPrivContentExposed :: IsContext c => FilePath -> c -> Property (HasInfo + Uni hasPrivContentExposed f = hasPrivContentExposedFrom (PrivDataSourceFile (PrivFile f) f) f hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike) -hasPrivContentExposedFrom = hasPrivContent' writeFile +hasPrivContentExposedFrom = hasPrivContent' NormalWrite -hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (FilePath -> String -> IO ()) -> s -> FilePath -> c -> Property (HasInfo + UnixLike) -hasPrivContent' writer source f context = +hasPrivContent' :: (IsContext c, IsPrivDataSource s) => FileWriteMode -> s -> FilePath -> c -> Property (HasInfo + UnixLike) +hasPrivContent' writemode source f context = withPrivData source context $ \getcontent -> property' desc $ \o -> getcontent $ \privcontent -> - ensureProperty o $ fileProperty' writer desc - (\_oldcontent -> privDataLines privcontent) f + ensureProperty o $ fileProperty' writemode desc + (\_oldcontent -> privDataByteString privcontent) f where desc = "privcontent " ++ f --- | Ensures that a line is present in a file, adding it to the end if not. -containsLine :: FilePath -> Line -> Property UnixLike -f `containsLine` l = f `containsLines` [l] - -containsLines :: FilePath -> [Line] -> Property UnixLike -f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f - where - go content = content ++ filter (`notElem` content) ls - --- | Ensures that a line is not present in a file. --- Note that the file is ensured to exist, so if it doesn't, an empty --- file will be written. -lacksLine :: FilePath -> Line -> Property UnixLike -f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f - -lacksLines :: FilePath -> [Line] -> Property UnixLike -f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f - -- | Replaces the content of a file with the transformed content of another file basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike f `basedOn` (f', a) = property' desc $ \o -> do tmpl <- liftIO $ readFile f' ensureProperty o $ fileProperty desc (\_ -> a $ lines $ tmpl) f where - desc = "replace " ++ f + desc = f ++ " is based on " ++ f' -- | Removes a file. Does not remove symlinks or non-plain-files. notPresent :: FilePath -> Property UnixLike notPresent f = check (doesFileExist f) $ property (f ++ " not present") $ makeChange $ nukeFile f -fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike -fileProperty = fileProperty' writeFile -fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property UnixLike -fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f) - where - go True = do - old <- liftIO $ readFile f - let new = unlines (a (lines old)) - if old == new - then noChange - else makeChange $ updatefile new `viaStableTmp` f - go False = makeChange $ writer f (unlines $ a []) - - -- Replicate the original file's owner and mode. - updatefile content f' = do - writer f' content - s <- getFileStatus f - setFileMode f' (fileMode s) - setOwnerAndGroup f' (fileOwner s) (fileGroup s) - -- | Ensures a directory exists. dirExists :: FilePath -> Property UnixLike dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $ @@ -172,6 +155,49 @@ mode f v = p `changesFile` f liftIO $ modifyFileMode f (const v) return NoChange +class FileContent c where + emptyFileContent :: c + readFileContent :: FilePath -> IO c + writeFileContent :: FileWriteMode -> FilePath -> c -> IO () + +data FileWriteMode = NormalWrite | ProtectedWrite + +instance FileContent [Line] where + emptyFileContent = [] + readFileContent f = lines <$> readFile f + writeFileContent NormalWrite f ls = writeFile f (unlines ls) + writeFileContent ProtectedWrite f ls = writeFileProtected f (unlines ls) + +instance FileContent L.ByteString where + emptyFileContent = L.empty + readFileContent = L.readFile + writeFileContent NormalWrite f c = L.writeFile f c + writeFileContent ProtectedWrite f c = + writeFileProtected' f (`L.hPutStr` c) + +-- | A property that applies a pure function to the content of a file. +fileProperty :: (FileContent c, Eq c) => Desc -> (c -> c) -> FilePath -> Property UnixLike +fileProperty = fileProperty' NormalWrite +fileProperty' :: (FileContent c, Eq c) => FileWriteMode -> Desc -> (c -> c) -> FilePath -> Property UnixLike +fileProperty' writemode desc a f = property desc $ go =<< liftIO (doesFileExist f) + where + go True = do + old <- liftIO $ readFileContent f + let new = a old + if old == new + then noChange + else makeChange $ updatefile new `viaStableTmp` f + go False = makeChange $ writer f (a emptyFileContent) + + -- Replicate the original file's owner and mode. + updatefile content dest = do + writer dest content + s <- getFileStatus f + setFileMode dest (fileMode s) + setOwnerAndGroup dest (fileOwner s) (fileGroup s) + + writer = writeFileContent writemode + -- | A temp file to use when writing new content for a file. -- -- This is a stable name so it can be removed idempotently. diff --git a/src/Propellor/Property/Firejail.hs b/src/Propellor/Property/Firejail.hs new file mode 100644 index 00000000..b7841e07 --- /dev/null +++ b/src/Propellor/Property/Firejail.hs @@ -0,0 +1,31 @@ +-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name> + +module Propellor.Property.Firejail ( + installed, + jailed, +) where + +import Propellor.Base +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.File as File + +-- | Ensures that Firejail is installed +installed :: Property DebianLike +installed = Apt.installed ["firejail"] + +-- | For each program name passed, create symlinks in /usr/local/bin that +-- will launch that program in a Firejail sandbox. +-- +-- The profile for the sandbox will be the same as if the user had run +-- @firejail@ directly without passing @--profile@ (see "SECURITY PROFILES" in +-- firejail(1)). +-- +-- See "DESKTOP INTEGRATION" in firejail(1). +jailed :: [String] -> Property DebianLike +jailed ps = (jailed' `applyToList` ps) + `requires` installed + `describe` unwords ("firejail jailed":ps) + +jailed' :: String -> Property UnixLike +jailed' p = ("/usr/local/bin" </> p) + `File.isSymlinkedTo` File.LinkTarget "/usr/bin/firejail" diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs index fcad9e87..58477468 100644 --- a/src/Propellor/Property/FreeBSD/Poudriere.hs +++ b/src/Propellor/Property/FreeBSD/Poudriere.hs @@ -9,7 +9,6 @@ module Propellor.Property.FreeBSD.Poudriere where import Propellor.Base import Propellor.Types.Info import Data.List -import Data.String (IsString(..)) import qualified Propellor.Property.FreeBSD.Pkg as Pkg import qualified Propellor.Property.ZFS as ZFS @@ -27,7 +26,7 @@ poudriereConfigured :: PoudriereConfigured -> Bool poudriereConfigured (PoudriereConfigured _) = True setConfigured :: Property (HasInfo + FreeBSD) -setConfigured = tightenTargets $ +setConfigured = tightenTargets $ pureInfoProperty "Poudriere Configured" (PoudriereConfigured "") poudriere :: Poudriere -> Property (HasInfo + FreeBSD) @@ -106,10 +105,10 @@ instance Show PoudriereArch where show I386 = "i386" show AMD64 = "amd64" -instance IsString PoudriereArch where - fromString "i386" = I386 - fromString "amd64" = AMD64 - fromString _ = error "Not a valid Poudriere architecture." +fromArchitecture :: Architecture -> PoudriereArch +fromArchitecture X86_64 = AMD64 +fromArchitecture X86_32 = I386 +fromArchitecture _ = error "Not a valid Poudriere architecture." yesNoProp :: Bool -> String yesNoProp b = if b then "yes" else "no" diff --git a/src/Propellor/Property/HostingProvider/DigitalOcean.hs b/src/Propellor/Property/HostingProvider/DigitalOcean.hs index c1e0ffc9..053338de 100644 --- a/src/Propellor/Property/HostingProvider/DigitalOcean.hs +++ b/src/Propellor/Property/HostingProvider/DigitalOcean.hs @@ -7,15 +7,13 @@ import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import qualified Propellor.Property.Reboot as Reboot -import Data.List - -- | Digital Ocean does not provide any way to boot -- the kernel provided by the distribution, except using kexec. -- Without this, some old, and perhaps insecure kernel will be used. -- -- This property causes the distro kernel to be loaded on reboot, using kexec. -- --- If the power is cycled, the non-distro kernel still boots up. +-- When the power is cycled, the non-distro kernel still boots up. -- So, this property also checks if the running kernel is present in /boot, -- and if not, reboots immediately into a distro kernel. distroKernel :: Property DebianLike @@ -25,25 +23,4 @@ distroKernel = propertyList "digital ocean distro kernel hack" $ props [ "LOAD_KEXEC=true" , "USE_GRUB_CONFIG=true" ] `describe` "kexec configured" - & check (not <$> runningInstalledKernel) Reboot.now - `describe` "running installed kernel" - -runningInstalledKernel :: IO Bool -runningInstalledKernel = do - kernelver <- takeWhile (/= '\n') <$> readProcess "uname" ["-r"] - when (null kernelver) $ - error "failed to read uname -r" - kernelimages <- concat <$> mapM kernelsIn ["/", "/boot/"] - when (null kernelimages) $ - error "failed to find any installed kernel images" - findVersion kernelver <$> - readProcess "file" ("-L" : kernelimages) - --- | File output looks something like this, we want to unambiguously --- match the running kernel version: --- Linux kernel x86 boot executable bzImage, version 3.16-3-amd64 (debian-kernel@lists.debian.org) #1 SMP Debian 3.1, RO-rootFS, swap_dev 0x2, Normal VGA -findVersion :: String -> String -> Bool -findVersion ver s = (" version " ++ ver ++ " ") `isInfixOf` s - -kernelsIn :: FilePath -> IO [FilePath] -kernelsIn d = filter ("vmlinu" `isInfixOf`) <$> dirContents d + & Reboot.toDistroKernel diff --git a/src/Propellor/Property/HostingProvider/Exoscale.hs b/src/Propellor/Property/HostingProvider/Exoscale.hs new file mode 100644 index 00000000..18e3c42f --- /dev/null +++ b/src/Propellor/Property/HostingProvider/Exoscale.hs @@ -0,0 +1,37 @@ +-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name> +-- +-- Properties for use on <https://www.exoscale.ch/> + +module Propellor.Property.HostingProvider.Exoscale ( + distroKernel, +) where + +import Propellor.Base +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Grub as Grub +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Reboot as Reboot + +-- | Flavor of kernel, eg "amd64" or "686" +type KernelFlavor = String + +-- | The current Exoshare Debian image doesn't install GRUB, so this property +-- makes sure GRUB is installed and correctly configured +-- +-- In case an old, insecure kernel is running, we check for an old kernel +-- version and reboot immediately if one is found. +-- +-- Note that we ignore anything after the first hyphen when considering +-- whether the running kernel's version is older than the Debian-supplied +-- kernel's version. +distroKernel :: KernelFlavor -> Property DebianLike +distroKernel kernelflavor = go `flagFile` theFlagFile + where + go = combineProperties "boots distro kernel" $ props + & Apt.installed ["grub2", "linux-image-" ++ kernelflavor] + & Grub.boots "/dev/vda" + & Grub.mkConfig + -- Since we're rebooting we have to manually create the flagfile + & File.hasContent theFlagFile [""] + & Reboot.toDistroKernel + theFlagFile = "/etc/propellor-distro-kernel" diff --git a/src/Propellor/Property/LetsEncrypt.hs b/src/Propellor/Property/LetsEncrypt.hs index 592a1e1d..9e4898dd 100644 --- a/src/Propellor/Property/LetsEncrypt.hs +++ b/src/Propellor/Property/LetsEncrypt.hs @@ -8,10 +8,8 @@ import qualified Propellor.Property.Apt as Apt import System.Posix.Files --- Not using the certbot name yet, until it reaches jessie-backports and --- testing. installed :: Property DebianLike -installed = Apt.installed ["letsencrypt"] +installed = Apt.installed ["certbot"] -- | Tell the letsencrypt client that you agree with the Let's Encrypt -- Subscriber Agreement. Providing an email address is recommended, diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index bb0f60a7..026509a9 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -118,7 +118,7 @@ blkidTag tag dev = catchDefaultIO Nothing $ umountLazy :: FilePath -> IO () umountLazy mnt = unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ - errorMessage $ "failed unmounting " ++ mnt + stopPropellorMessage $ "failed unmounting " ++ mnt -- | Unmounts anything mounted inside the specified directory. unmountBelow :: FilePath -> IO () diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index 5a3ccc70..d974cfbc 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -22,7 +22,7 @@ import Control.Exception (throw) -- | Replaces whatever OS was installed before with a clean installation -- of the OS that the Host is configured to have. --- +-- -- This is experimental; use with caution! -- -- This can replace one Linux distribution with different one. @@ -35,7 +35,7 @@ import Control.Exception (throw) -- This property only runs once. The cleanly installed system will have -- a file </etc/propellor-cleaninstall>, which indicates it was cleanly -- installed. --- +-- -- The files from the old os will be left in </old-os> -- -- After the OS is installed, and if all properties of the host have @@ -46,7 +46,7 @@ import Control.Exception (throw) -- install succeeds, to bootstrap from the cleanly installed system to -- a fully working system. For example: -- --- > & osDebian Unstable "amd64" +-- > & osDebian Unstable X86_64 -- > & cleanInstallOnce (Confirmed "foo.example.com") -- > `onChange` propertyList "fixing up after clean install" -- > [ preserveNetwork @@ -68,7 +68,7 @@ cleanInstallOnce :: Confirmation -> Property Linux cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ go `requires` confirmed "clean install confirmed" confirmation where - go = + go = finalized `requires` -- easy to forget and system may not boot without shadow pw! @@ -85,19 +85,19 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ osbootstrapped :: Property Linux osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \w o -> case o of - (Just d@(System (Debian _) _)) -> ensureProperty w $ + (Just d@(System (Debian _ _) _)) -> ensureProperty w $ debootstrap d (Just u@(System (Buntish _) _)) -> ensureProperty w $ debootstrap u _ -> unsupportedOS' - + debootstrap :: System -> Property Linux debootstrap targetos = -- Install debootstrap from source, since we don't know -- what OS we're currently running in. Debootstrap.built' Debootstrap.sourceInstall newOSDir targetos Debootstrap.DefaultConfig - -- debootstrap, I wish it was faster.. + -- debootstrap, I wish it was faster.. -- TODO eatmydata to speed it up -- Problem: Installing eatmydata on some random OS like -- Fedora may be difficult. Maybe configure dpkg to not @@ -120,7 +120,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ createDirectoryIfMissing True oldOSDir massRename (renamesout ++ renamesin) removeDirectoryRecursive newOSDir - + -- Prepare environment for running additional properties, -- overriding old OS's environment. void $ setEnv "PATH" stdPATH True @@ -150,15 +150,15 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ -- git repo url, which all need to be arranged to -- be present in /old-os's /usr/local/propellor) -- TODO - + finalized :: Property UnixLike finalized = property "clean OS installed" $ do liftIO $ writeFile flagfile "" return MadeChange flagfile = "/etc/propellor-cleaninstall" - - trickydirs = + + trickydirs = -- /tmp can contain X's sockets, which prevent moving it -- so it's left as-is. [ "/tmp" @@ -195,7 +195,7 @@ confirmed desc (Confirmed c) = property desc $ do return FailedChange else return NoChange --- | </etc/network/interfaces> is configured to bring up the network +-- | </etc/network/interfaces> is configured to bring up the network -- interface that currently has a default route configured, using -- the same (static) IP address. preserveNetwork :: Property DebianLike @@ -210,7 +210,7 @@ preserveNetwork = go `requires` Network.cleanInterfacesFile ensureProperty w $ Network.static iface _ -> do warningMessage "did not find any default ipv4 route" - return FailedChange + return FailedChange -- | </etc/resolv.conf> is copied from the old OS preserveResolvConf :: Property Linux diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs index 5b854fa3..31731dc2 100644 --- a/src/Propellor/Property/Reboot.hs +++ b/src/Propellor/Property/Reboot.hs @@ -1,12 +1,34 @@ -module Propellor.Property.Reboot where +module Propellor.Property.Reboot ( + now, + atEnd, + toDistroKernel, + toKernelNewerThan, + KernelVersion, +) where import Propellor.Base +import Data.List +import Data.Version +import Text.ParserCombinators.ReadP + +-- | Kernel version number, in a string. +type KernelVersion = String + +-- | Using this property causes an immediate reboot. +-- +-- So, this is not a useful property on its own, but it can be useful to +-- compose with other properties. For example: +-- +-- > Apt.installed ["new-kernel"] +-- > `onChange` Reboot.now now :: Property Linux now = tightenTargets $ cmdProperty "reboot" [] `assume` MadeChange `describe` "reboot now" +type Force = Bool + -- | Schedules a reboot at the end of the current propellor run. -- -- The `Result` code of the entire propellor run can be checked; @@ -14,7 +36,7 @@ now = tightenTargets $ cmdProperty "reboot" [] -- -- The reboot can be forced to run, which bypasses the init system. Useful -- if the init system might not be running for some reason. -atEnd :: Bool -> (Result -> Bool) -> Property Linux +atEnd :: Force -> (Result -> Bool) -> Property Linux atEnd force resultok = property "scheduled reboot at end of propellor run" $ do endAction "rebooting" atend return NoChange @@ -28,3 +50,88 @@ atEnd force resultok = property "scheduled reboot at end of propellor run" $ do rebootparams | force = [Param "--force"] | otherwise = [] + +-- | Reboots immediately if a kernel other than the distro-installed kernel is +-- running. +-- +-- This will only work if you have taken measures to ensure that the other +-- kernel won't just get booted again. +-- See 'Propellor.Property.HostingProvider.DigitalOcean' +-- for an example of how to do this. +toDistroKernel :: Property DebianLike +toDistroKernel = check (not <$> runningInstalledKernel) now + `describe` "running installed kernel" + +-- | Given a kernel version string @v@, reboots immediately if the running +-- kernel version is strictly less than @v@ and there is an installed kernel +-- version is greater than or equal to @v@. Fails if the requested kernel +-- version is not installed. +-- +-- For this to be useful, you need to have ensured that the installed kernel +-- with the highest version number is the one that will be started after a +-- reboot. +-- +-- This is useful when upgrading to a new version of Debian where you need to +-- ensure that a new enough kernel is running before ensuring other properties. +toKernelNewerThan :: KernelVersion -> Property DebianLike +toKernelNewerThan ver = + property' ("reboot to kernel newer than " ++ ver) $ \w -> do + wantV <- tryReadVersion ver + runningV <- tryReadVersion =<< liftIO runningKernelVersion + installedV <- maximum <$> + (mapM tryReadVersion =<< liftIO installedKernelVersions) + if runningV >= wantV then noChange + else if installedV >= wantV + then ensureProperty w now + else errorMessage $ + "kernel newer than " + ++ ver + ++ " not installed" + +runningInstalledKernel :: IO Bool +runningInstalledKernel = do + kernelver <- runningKernelVersion + when (null kernelver) $ + error "failed to read uname -r" + kernelimages <- installedKernelImages + when (null kernelimages) $ + error "failed to find any installed kernel images" + findVersion kernelver <$> + readProcess "file" ("-L" : kernelimages) + +runningKernelVersion :: IO KernelVersion +runningKernelVersion = takeWhile (/= '\n') <$> readProcess "uname" ["-r"] + +installedKernelImages :: IO [String] +installedKernelImages = concat <$> mapM kernelsIn ["/", "/boot/"] + +-- | File output looks something like this, we want to unambiguously +-- match the running kernel version: +-- Linux kernel x86 boot executable bzImage, version 3.16-3-amd64 (debian-kernel@lists.debian.org) #1 SMP Debian 3.1, RO-rootFS, swap_dev 0x2, Normal VGA +findVersion :: KernelVersion -> String -> Bool +findVersion ver s = (" version " ++ ver ++ " ") `isInfixOf` s + +installedKernelVersions :: IO [KernelVersion] +installedKernelVersions = do + kernelimages <- installedKernelImages + when (null kernelimages) $ + error "failed to find any installed kernel images" + imageLines <- lines <$> readProcess "file" ("-L" : kernelimages) + return $ extractKernelVersion <$> imageLines + +kernelsIn :: FilePath -> IO [FilePath] +kernelsIn d = filter ("vmlinu" `isInfixOf`) <$> dirContents d + +extractKernelVersion :: String -> KernelVersion +extractKernelVersion = + unwords . take 1 . drop 1 . dropWhile (/= "version") . words + +readVersionMaybe :: KernelVersion -> Maybe Version +readVersionMaybe ver = case map fst $ readP_to_S parseVersion ver of + [] -> Nothing + l -> Just $ maximum l + +tryReadVersion :: KernelVersion -> Propellor Version +tryReadVersion ver = case readVersionMaybe ver of + Just x -> return x + Nothing -> errorMessage ("couldn't parse version " ++ ver) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 2647e69e..5d58a84a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -8,10 +8,10 @@ Build and maintain schroots for use with sbuild. Suggested usage in @config.hs@: -> & Apt.installed ["piuparts"] -> & Sbuild.builtFor (System (Debian Unstable) "i386") -> & Sbuild.piupartsConfFor (System (Debian Unstable) "i386") -> & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly 1 +> & Apt.installed ["piuparts", "autopkgtest"] +> & Sbuild.builtFor (System (Debian Unstable) X86_32) +> & Sbuild.piupartsConfFor (System (Debian Unstable) X86_32) +> & Sbuild.updatedFor (System (Debian Unstable) X86_32) `period` Weekly 1 > & Sbuild.usableBy (User "spwhitton") > & Sbuild.shareAptCache > & Schroot.overlaysInTmpfs @@ -56,16 +56,17 @@ sbuild environment as standard as possible. module Propellor.Property.Sbuild ( -- * Creating and updating sbuild schroots SbuildSchroot(..), - builtFor, built, updated, + piupartsConf, + builtFor, updatedFor, piupartsConfFor, - piupartsConf, -- * Global sbuild configuration -- blockNetwork, installed, keypairGenerated, + keypairInsecurelyGenerated, shareAptCache, usableBy, ) where @@ -78,6 +79,8 @@ import qualified Propellor.Property.Ccache as Ccache import qualified Propellor.Property.ConfFile as ConfFile import qualified Propellor.Property.File as File -- import qualified Propellor.Property.Firewall as Firewall +import qualified Propellor.Property.Schroot as Schroot +import qualified Propellor.Property.Reboot as Reboot import qualified Propellor.Property.User as User import Utility.FileMode @@ -93,13 +96,13 @@ type Suite = String data SbuildSchroot = SbuildSchroot Suite Architecture instance Show SbuildSchroot where - show (SbuildSchroot suite arch) = suite ++ "-" ++ arch + show (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch -- | Build and configure a schroot for use with sbuild using a distribution's -- standard mirror -- --- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the --- user to identify the schroot and distribution using the 'System' type +-- This function is a convenience wrapper around 'built', allowing the user to +-- identify the schroot and distribution using the 'System' type builtFor :: System -> RevertableProperty DebianLike UnixLike builtFor sys = go <!> deleted where @@ -121,7 +124,8 @@ built s@(SbuildSchroot suite arch) mirror = (go `requires` keypairGenerated `requires` ccachePrepared - `requires` installed) + `requires` installed + `requires` overlaysKernel) <!> deleted where go :: Property DebianLike @@ -130,7 +134,7 @@ built s@(SbuildSchroot suite arch) mirror = make w = do de <- liftIO standardPathEnv let params = Param <$> - [ "--arch=" ++ arch + [ "--arch=" ++ architectureToDebianArchString arch , "--chroot-suffix=-propellor" , "--include=eatmydata,ccache" , suite @@ -153,15 +157,38 @@ built s@(SbuildSchroot suite arch) mirror = makeChange $ nukeFile (schrootConf s) -- if we're building a sid chroot, add useful aliases + -- In order to avoid more than one schroot getting the same aliases, we + -- only do this if the arch of the chroot equals the host arch. aliasesLine :: Property UnixLike - aliasesLine = if suite == "unstable" - then File.containsLine (schrootConf s) - "aliases=UNRELEASED,sid,rc-buggy,experimental" - else doNothing + aliasesLine = property' "maybe set aliases line" $ \w -> do + maybeOS <- getOS + case maybeOS of + Nothing -> return NoChange + Just (System _ hostArch) -> + if suite == "unstable" && hostArch == arch + then ensureProperty w $ + schrootConf s `File.containsLine` aliases + else return NoChange + -- enable ccache and eatmydata for speed commandPrefix = File.containsLine (schrootConf s) "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata" + -- If the user has indicated that this host should use + -- union-type=overlay schroots, we need to ensure that we have rebooted + -- to a kernel supporting OverlayFS before we execute + -- sbuild-setupchroot(1). Otherwise, sbuild-setupchroot(1) will fail to + -- add the union-type=overlay line to the schroot config. + -- (We could just add that line ourselves, but then sbuild wouldn't work + -- for the user, so we might as well do the reboot for them.) + overlaysKernel :: Property DebianLike + overlaysKernel = property' "reboot for union-type=overlay" $ \w -> + Schroot.usesOverlays >>= \usesOverlays -> + if usesOverlays + then ensureProperty w $ + Reboot.toKernelNewerThan "3.18" + else noChange + -- A failed debootstrap run will leave a debootstrap directory; -- recover by deleting it and trying again. ispartial = ifM (doesDirectoryExist (schrootRoot s </> "debootstrap")) @@ -171,10 +198,12 @@ built s@(SbuildSchroot suite arch) mirror = , return False ) + aliases = "aliases=UNRELEASED,sid,rc-buggy,experimental" + -- | Ensure that an sbuild schroot's packages and apt indexes are updated -- --- This function is a convenience wrapper around 'Sbuild.updated', allowing the --- user to identify the schroot using the 'System' type +-- This function is a convenience wrapper around 'updated', allowing the user to +-- identify the schroot using the 'System' type updatedFor :: System -> Property DebianLike updatedFor system = property' ("updated sbuild schroot for " ++ show system) $ \w -> case schrootFromSystem system of @@ -192,7 +221,7 @@ updated s@(SbuildSchroot suite arch) = where go :: Property DebianLike go = tightenTargets $ cmdProperty - "sbuild-update" ["-udr", suite ++ "-" ++ arch] + "sbuild-update" ["-udr", suite ++ "-" ++ architectureToDebianArchString arch] `assume` MadeChange -- Find the conf file that sbuild-createchroot(1) made when we passed it @@ -219,15 +248,14 @@ fixConfFile s@(SbuildSchroot suite arch) = where new = schrootConf s dir = takeDirectory new - tempPrefix = dir </> suite ++ "-" ++ arch ++ "-propellor-" + tempPrefix = dir </> suite ++ "-" ++ architectureToDebianArchString arch ++ "-propellor-" munge = replace "-propellor]" "-sbuild]" -- | Create a corresponding schroot config file for use with piuparts -- --- This function is a convenience wrapper around 'Sbuild.piupartsConf', allowing --- the user to identify the schroot using the 'System' type. See that --- function's documentation for why you might want to use this property, and --- sample config. +-- This function is a convenience wrapper around 'piupartsConf', allowing the +-- user to identify the schroot using the 'System' type. See that function's +-- documentation for why you might want to use this property, and sample config. piupartsConfFor :: System -> Property DebianLike piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $ \w -> case (schrootFromSystem sys, stdMirror sys) of @@ -240,11 +268,11 @@ piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $ -- -- This is useful because: -- --- - piuparts will clear out the apt cache which makes 'Sbuild.shareAptCache' --- much less useful +-- - piuparts will clear out the apt cache which makes 'shareAptCache' much less +-- useful -- -- - piuparts itself invokes eatmydata, so the command-prefix setting in our --- regular schroot config would force the user to pass --no-eatmydata to +-- regular schroot config would force the user to pass @--no-eatmydata@ to -- piuparts in their @~/.sbuildrc@, which is inconvenient. -- -- To make use of this new schroot config, you can put something like this in @@ -290,7 +318,7 @@ piupartsConf s u = go f = schrootPiupartsConf s munge = replace "-sbuild]" "-piuparts]" --- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host +-- | Bind-mount /var/cache/apt/archives in all sbuild chroots so that the host -- system and the chroot share the apt cache -- -- This speeds up builds by avoiding unnecessary downloads of build @@ -315,12 +343,30 @@ usableBy u = User.hasGroup u (Group "sbuild") `requires` installed keypairGenerated :: Property DebianLike keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go `requires` installed + -- Work around Debian bug #792100 which is present in Jessie. + -- Since this is a harmless mkdir, don't actually check the OS + `requires` File.dirExists "/root/.gnupg" where go :: Property DebianLike go = tightenTargets $ cmdProperty "sbuild-update" ["--keygen"] `assume` MadeChange - secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" + +secKeyFile :: FilePath +secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" + +-- | Generate the apt keys needed by sbuild using a low-quality source of +-- randomness +-- +-- Useful on throwaway build VMs. +keypairInsecurelyGenerated :: Property DebianLike +keypairInsecurelyGenerated = check (not <$> doesFileExist secKeyFile) go + where + go :: Property DebianLike + go = combineProperties "sbuild keyring insecurely generated" $ props + & Apt.installed ["rng-tools"] + & cmdProperty "rngd" ["-r", "/dev/urandom"] `assume` MadeChange + & keypairGenerated -- another script from wiki.d.o/sbuild ccachePrepared :: Property DebianLike @@ -367,17 +413,17 @@ schrootFromSystem system@(System _ arch) = >>= \suite -> return $ SbuildSchroot suite arch stdMirror :: System -> Maybe Apt.Url -stdMirror (System (Debian _) _) = Just "http://httpredir.debian.org/debian" +stdMirror (System (Debian _ _) _) = Just "http://httpredir.debian.org/debian" stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/" stdMirror _ = Nothing schrootRoot :: SbuildSchroot -> FilePath -schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ a +schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ architectureToDebianArchString a schrootConf :: SbuildSchroot -> FilePath schrootConf (SbuildSchroot s a) = - "/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-sbuild-propellor" + "/etc/schroot/chroot.d" </> s ++ "-" ++ architectureToDebianArchString a ++ "-sbuild-propellor" schrootPiupartsConf :: SbuildSchroot -> FilePath schrootPiupartsConf (SbuildSchroot s a) = - "/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-piuparts-propellor" + "/etc/schroot/chroot.d" </> s ++ "-" ++ architectureToDebianArchString a ++ "-piuparts-propellor" diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs index c53ce4f1..bb20f6e6 100644 --- a/src/Propellor/Property/Schroot.hs +++ b/src/Propellor/Property/Schroot.hs @@ -1,42 +1,63 @@ -- | Maintainer: Sean Whitton <spwhitton@spwhitton.name> +{-# LANGUAGE DeriveDataTypeable #-} + module Propellor.Property.Schroot where import Propellor.Base +import Propellor.Types.Info import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import Utility.FileMode +data UseOverlays = UseOverlays deriving (Eq, Show, Typeable) + +-- | Indicate that a schroots on a host should use @union-type=overlay@ +-- +-- Setting this property does not actually ensure that the line +-- @union-type=overlay@ is present in any schroot config files. See +-- 'Propellor.Property.Sbuild.built' for example usage. +useOverlays :: Property (HasInfo + UnixLike) +useOverlays = pureInfoProperty "use schroot overlays" (InfoVal UseOverlays) + +-- | Gets whether a host uses overlays. +usesOverlays :: Propellor Bool +usesOverlays = isJust . fromInfoVal + <$> (askInfo :: Propellor (InfoVal UseOverlays)) + -- | Configure schroot such that all schroots with @union-type=overlay@ in their -- configuration will run their overlays in a tmpfs. -- +-- Implicitly sets 'useOverlays' info property. +-- -- Shell script from <https://wiki.debian.org/sbuild>. -overlaysInTmpfs :: Property DebianLike +overlaysInTmpfs :: Property (HasInfo + DebianLike) overlaysInTmpfs = go `requires` installed where f = "/etc/schroot/setup.d/04tmpfs" - go :: Property UnixLike - go = f `File.hasContent` - [ "#!/bin/sh" - , "" - , "set -e" - , "" - , ". \"$SETUP_DATA_DIR/common-data\"" - , ". \"$SETUP_DATA_DIR/common-functions\"" - , ". \"$SETUP_DATA_DIR/common-config\"" - , "" - , "" - , "if [ $STAGE = \"setup-start\" ]; then" - , " mount -t tmpfs overlay /var/lib/schroot/union/overlay" - , "elif [ $STAGE = \"setup-recover\" ]; then" - , " mount -t tmpfs overlay /var/lib/schroot/union/overlay" - , "elif [ $STAGE = \"setup-stop\" ]; then" - , " umount -f /var/lib/schroot/union/overlay" - , "fi" - ] - `onChange` (f `File.mode` (combineModes (readModes ++ executeModes))) - `describe` "schroot overlays in tmpfs" + go :: Property (HasInfo + UnixLike) + go = combineProperties "schroot overlays in tmpfs" $ props + & useOverlays + & f `File.hasContent` + [ "#!/bin/sh" + , "" + , "set -e" + , "" + , ". \"$SETUP_DATA_DIR/common-data\"" + , ". \"$SETUP_DATA_DIR/common-functions\"" + , ". \"$SETUP_DATA_DIR/common-config\"" + , "" + , "" + , "if [ $STAGE = \"setup-start\" ]; then" + , " mount -t tmpfs overlay /var/lib/schroot/union/overlay" + , "elif [ $STAGE = \"setup-recover\" ]; then" + , " mount -t tmpfs overlay /var/lib/schroot/union/overlay" + , "elif [ $STAGE = \"setup-stop\" ]; then" + , " umount -f /var/lib/schroot/union/overlay" + , "fi" + ] + `onChange` (f `File.mode` combineModes (readModes ++ executeModes)) installed :: Property DebianLike installed = Apt.installed ["schroot"] diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index b4812c7e..90c9c7bf 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -25,7 +25,9 @@ builddir = gitbuilderdir </> "build" type TimeOut = String -- eg, 5h -autobuilder :: Architecture -> Times -> TimeOut -> Property (HasInfo + DebianLike) +type ArchString = String + +autobuilder :: ArchString -> Times -> TimeOut -> Property (HasInfo + DebianLike) autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props & Apt.serviceInstalledRunning "cron" & Cron.niceJob "gitannexbuilder" crontimes (User builduser) gitbuilderdir @@ -47,7 +49,7 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props then makeChange $ writeFile pwfile want else noChange -tree :: Architecture -> Flavor -> Property DebianLike +tree :: ArchString -> Flavor -> Property DebianLike tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props & Apt.installed ["git"] & File.dirExists gitbuilderdir @@ -55,7 +57,7 @@ tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props & gitannexbuildercloned & builddircloned where - gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $ + gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $ userScriptProperty (User builduser) [ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir , "cd " ++ gitbuilderdir @@ -85,7 +87,7 @@ buildDepsNoHaskellLibs = Apt.installed ] haskellPkgsInstalled :: String -> Property DebianLike -haskellPkgsInstalled dir = tightenTargets $ +haskellPkgsInstalled dir = tightenTargets $ flagFile go ("/haskellpkgsinstalled") where go = userScriptProperty (User builduser) @@ -107,9 +109,9 @@ autoBuilderContainer :: (DebianSuite -> Architecture -> Flavor -> Property (HasI autoBuilderContainer mkprop suite arch flavor crontime timeout = Systemd.container name $ \d -> Chroot.debootstrapped mempty d $ props & mkprop suite arch flavor - & autobuilder arch crontime timeout + & autobuilder (architectureToDebianArchString arch) crontime timeout where - name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder" + name = architectureToDebianArchString arch ++ fromMaybe "" flavor ++ "-git-annex-builder" type Flavor = Maybe String @@ -122,7 +124,7 @@ standardAutoBuilder suite arch flavor = & Apt.unattendedUpgrades & Apt.cacheCleaned & User.accountFor (User builduser) - & tree arch flavor + & tree (architectureToDebianArchString arch) flavor stackAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian) stackAutoBuilder suite arch flavor = @@ -133,7 +135,7 @@ stackAutoBuilder suite arch flavor = & Apt.unattendedUpgrades & Apt.cacheCleaned & User.accountFor (User builduser) - & tree arch flavor + & tree (architectureToDebianArchString arch) flavor & stackInstalled -- Workaround https://github.com/commercialhaskell/stack/issues/2093 & Apt.installed ["libtinfo-dev"] @@ -141,15 +143,15 @@ stackAutoBuilder suite arch flavor = stackInstalled :: Property Linux stackInstalled = withOS "stack installed" $ \w o -> case o of - (Just (System (Debian (Stable "jessie")) "i386")) -> - ensureProperty w $ manualinstall "i386" + (Just (System (Debian Linux (Stable "jessie")) X86_32)) -> + ensureProperty w $ manualinstall X86_32 _ -> ensureProperty w $ Apt.installed ["haskell-stack"] where -- Warning: Using a binary downloaded w/o validation. manualinstall :: Architecture -> Property Linux manualinstall arch = tightenTargets $ check (not <$> doesFileExist binstack) $ propertyList "stack installed from upstream tarball" $ props - & cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ arch, "-O", tmptar] + & cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ architectureToDebianArchString arch, "-O", tmptar] `assume` MadeChange & File.dirExists tmpdir & cmdProperty "tar" ["xf", tmptar, "-C", tmpdir, "--strip-components=1"] @@ -163,7 +165,7 @@ stackInstalled = withOS "stack installed" $ \w o -> tmpdir = "/root/stack" armAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian) -armAutoBuilder suite arch flavor = +armAutoBuilder suite arch flavor = propertyList "arm git-annex autobuilder" $ props & standardAutoBuilder suite arch flavor & buildDepsNoHaskellLibs @@ -187,9 +189,9 @@ androidAutoBuilderContainer' -> Times -> TimeOut -> Systemd.Container -androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout = +androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout = Systemd.container name $ \d -> bootstrap d $ props - & osDebian (Stable "jessie") "i386" + & osDebian (Stable "jessie") X86_32 & Apt.stdSourcesList & User.accountFor (User builduser) & File.dirExists gitbuilderdir diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index a6cb3794..652a7141 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -103,7 +103,7 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props & oldUseNetInstalled "oldusenet-server" & oldUseNetBackup & spoolsymlink - & "/etc/news/leafnode/config" `File.hasContent` + & "/etc/news/leafnode/config" `File.hasContent` [ "# olduse.net configuration (deployed by propellor)" , "expire = 1000000" -- no expiry via texpire , "server = " -- no upstream server @@ -134,7 +134,7 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props , Apache.allowAll , " </Directory>" ] - + spoolsymlink :: Property UnixLike spoolsymlink = check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool) (property "olduse.net spool in place" $ makeChange $ do @@ -177,7 +177,7 @@ oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $ ] `assume` MadeChange `describe` "olduse.net built" - + kgbServer :: Property (HasInfo + Debian) kgbServer = propertyList desc $ props & installed @@ -187,7 +187,7 @@ kgbServer = propertyList desc $ props desc = "kgb.kitenet.net setup" installed :: Property Debian installed = withOS desc $ \w o -> case o of - (Just (System (Debian Unstable) _)) -> + (Just (System (Debian _ Unstable) _)) -> ensureProperty w $ propertyList desc $ props & Apt.serviceInstalledRunning "kgb-bot" & "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1" @@ -289,7 +289,7 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann postupdatehook = dir </> ".git/hooks/post-update" setup = userScriptProperty (User "joey") setupscript `assume` MadeChange - setupscript = + setupscript = [ "cd " ++ shellEscape dir , "git annex reinit " ++ shellEscape uuid ] ++ map addremote remotes ++ @@ -316,7 +316,7 @@ apacheSite :: HostName -> Apache.ConfigFile -> RevertableProperty DebianLike Deb apacheSite hn middle = Apache.siteEnabled hn $ apachecfg hn middle apachecfg :: HostName -> Apache.ConfigFile -> Apache.ConfigFile -apachecfg hn middle = +apachecfg hn middle = [ "<VirtualHost *:"++show port++">" , " ServerAdmin grue@joeyh.name" , " ServerName "++hn++":"++show port @@ -333,7 +333,7 @@ apachecfg hn middle = ] where port = 80 :: Int - + gitAnnexDistributor :: Property (HasInfo + DebianLike) gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer" $ props & Apt.installed ["rsync"] @@ -360,7 +360,7 @@ downloads hosts = annexWebSite "/srv/git/downloads.git" "840760dc-08f0-11e2-8c61-576b7e66acfd" [("eubackup", "ssh://eubackup.kitenet.net/~/lib/downloads/")] `requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "joey") - + tmp :: Property (HasInfo + DebianLike) tmp = propertyList "tmp.kitenet.net" $ props & annexWebSite "/srv/git/joey/tmp.git" @@ -384,7 +384,7 @@ twitRss = combineProperties "twitter rss" $ props "./twitRss " ++ shellEscape url ++ " > " ++ shellEscape ("../" ++ desc ++ ".rss") compiled = userScriptProperty (User "joey") [ "cd " ++ dir - , "ghc --make twitRss" + , "ghc --make twitRss" ] `assume` NoChange `requires` Apt.installed @@ -447,7 +447,7 @@ githubBackup = propertyList "github-backup box" $ props gitriddance (r, msg) = "(cd " ++ r ++ " && gitriddance " ++ shellEscape msg ++ ")" githubKeys :: Property (HasInfo + UnixLike) -githubKeys = +githubKeys = let f = "/home/joey/.github-keys" in File.hasPrivContent f anyContext `onChange` File.ownerGroup f (User "joey") (Group "joey") @@ -511,14 +511,14 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props ] `onChange` Service.restarted "spamassassin" `describe` "spamd enabled" `requires` Apt.serviceInstalledRunning "cron" - + & Apt.serviceInstalledRunning "spamass-milter" -- Add -m to prevent modifying messages Subject or body. & "/etc/default/spamass-milter" `File.containsLine` "OPTIONS=\"-m -u spamass-milter -i 127.0.0.1\"" `onChange` Service.restarted "spamass-milter" `describe` "spamass-milter configured" - + & Apt.serviceInstalledRunning "amavisd-milter" & "/etc/default/amavisd-milter" `File.containsLines` [ "# Propellor deployed" @@ -642,7 +642,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props `onChange` Postfix.dedupMainCf `onChange` Postfix.reloaded `describe` "postfix configured" - + & Apt.serviceInstalledRunning "dovecot-imapd" & Apt.serviceInstalledRunning "dovecot-pop3d" & "/etc/dovecot/conf.d/10-mail.conf" `File.containsLine` @@ -679,16 +679,18 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props , "inbox-path={localhost/novalidate-cert/NoRsh}inbox" ] `describe` "pine configured to use local imap server" - + & Apt.serviceInstalledRunning "mailman" & Postfix.service ssmtp + + & Apt.installed ["fetchmail"] where ctx = Context "kitenet.net" pinescript = "/usr/local/bin/pine" dovecotusers = "/etc/dovecot/users" - ssmtp = Postfix.Service + ssmtp = Postfix.Service (Postfix.InetService Nothing "ssmtp") "smtpd" Postfix.defServiceOpts @@ -825,7 +827,7 @@ legacyWebSites = propertyList "legacy web sites" $ props , "RewriteRule ^/joey/index.html http://www.kitenet.net/joey/ [R]" , "RewriteRule ^/wifi http://www.kitenet.net/wifi/ [R]" , "RewriteRule ^/wifi/index.html http://www.kitenet.net/wifi/ [R]" - + , "# Old ikiwiki filenames for kitenet.net wiki." , "rewritecond $1 !^/~" , "rewritecond $1 !^/doc/" @@ -912,7 +914,7 @@ legacyWebSites = propertyList "legacy web sites" $ props , "rewritecond $1 !.*/index$" , "rewriterule (.+).rss$ http://joeyh.name/$1/index.rss [l]" - + , "# Redirect all to joeyh.name." , "rewriterule (.*) http://joeyh.name$1 [r]" ] diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index e11c991e..78529f73 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -204,7 +204,7 @@ machined :: Property Linux machined = withOS "machined installed" $ \w o -> case o of -- Split into separate debian package since systemd 225. - (Just (System (Debian suite) _)) + (Just (System (Debian _ suite) _)) | not (isStable suite) -> ensureProperty w $ Apt.installed ["systemd-container"] _ -> noChange @@ -217,11 +217,11 @@ machined = withOS "machined installed" $ \w o -> -- to bootstrap. -- -- > container "webserver" $ \d -> Chroot.debootstrapped mempty d $ props --- > & osDebian Unstable "amd64" +-- > & osDebian Unstable X86_64 -- > & Apt.installedRunning "apache2" -- > & ... container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container -container name mkchroot = +container name mkchroot = let c = Container name chroot h in setContainerProps c $ containerProps c &^ resolvConfed @@ -238,7 +238,7 @@ container name mkchroot = -- to bootstrap. -- -- > debContainer "webserver" $ props --- > & osDebian Unstable "amd64" +-- > & osDebian Unstable X86_64 -- > & Apt.installedRunning "apache2" -- > & ... debContainer :: MachineName -> Props metatypes -> Container @@ -447,7 +447,7 @@ instance Publishable (Proto, Bound Port) where -- > -- > webserver :: Systemd.container -- > webserver = Systemd.container "webserver" (Chroot.debootstrapped mempty) --- > & os (System (Debian Testing) "amd64") +-- > & os (System (Debian Testing) X86_64) -- > & Systemd.privateNetwork -- > & Systemd.running Systemd.networkd -- > & Systemd.publish (Port 80 ->- Port 8080) diff --git a/src/Propellor/Types/Exception.hs b/src/Propellor/Types/Exception.hs new file mode 100644 index 00000000..9fdcab93 --- /dev/null +++ b/src/Propellor/Types/Exception.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Propellor.Types.Exception where + +import Data.Typeable +import Control.Exception + +-- | Normally when an exception is encountered while propellor is +-- ensuring a property, the property fails, but propellor robustly +-- continues on to the next property. +-- +-- This is the only exception that will stop the entire propellor run, +-- preventing any subsequent properties of the Host from being ensured. +-- (When propellor is running in a container in a Host, this exception only +-- stops the propellor run in the container; the outer run in the Host +-- continues.) +-- +-- You should only throw this exception when things are so badly messed up +-- that it's best for propellor to not try to do anything else. +data StopPropellorException = StopPropellorException String + deriving (Show, Typeable) + +instance Exception StopPropellorException diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs index d7df5490..b569a6e8 100644 --- a/src/Propellor/Types/OS.hs +++ b/src/Propellor/Types/OS.hs @@ -4,12 +4,14 @@ module Propellor.Types.OS ( System(..), Distribution(..), TargetOS(..), + DebianKernel(..), DebianSuite(..), FreeBSDRelease(..), FBSDVersion(..), isStable, Release, - Architecture, + Architecture(..), + architectureToDebianArchString, HostName, UserName, User(..), @@ -29,7 +31,7 @@ data System = System Distribution Architecture deriving (Show, Eq, Typeable) data Distribution - = Debian DebianSuite + = Debian DebianKernel DebianSuite | 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/> | FreeBSD FreeBSDRelease deriving (Show, Eq) @@ -43,10 +45,15 @@ data TargetOS deriving (Show, Eq, Ord) systemToTargetOS :: System -> TargetOS -systemToTargetOS (System (Debian _) _) = OSDebian +systemToTargetOS (System (Debian _ _) _) = OSDebian systemToTargetOS (System (Buntish _) _) = OSBuntish systemToTargetOS (System (FreeBSD _) _) = OSFreeBSD +-- | Most of Debian ports are based on Linux. There also exist hurd-i386, +-- kfreebsd-i386, kfreebsd-amd64 ports +data DebianKernel = Linux | KFreeBSD | Hurd + deriving (Show, Eq) + -- | Debian has several rolling suites, and a number of stable releases, -- such as Stable "jessie". data DebianSuite = Experimental | Unstable | Testing | Stable Release @@ -75,7 +82,53 @@ isStable (Stable _) = True isStable _ = False type Release = String -type Architecture = String + +-- | Many of these architecture names are based on the names used by +-- Debian, with a few exceptions for clarity. +data Architecture + = X86_64 -- ^ 64 bit Intel, called "amd64" in Debian + | X86_32 -- ^ 32 bit Intel, called "i386" in Debian + | ARMHF + | ARMEL + | PPC + | PPC64 + | SPARC + | SPARC64 + | MIPS + | MIPSEL + | MIPS64EL + | SH4 + | IA64 -- ^ Itanium + | S390 + | S390X + | ALPHA + | HPPA + | M68K + | ARM64 + | X32 -- ^ New Linux ABI for 64 bit CPUs using 32-bit integers. Not widely used. + deriving (Show, Eq) + +architectureToDebianArchString :: Architecture -> String +architectureToDebianArchString X86_64 = "amd64" +architectureToDebianArchString X86_32 = "i386" +architectureToDebianArchString ARMHF = "armhf" +architectureToDebianArchString ARMEL = "armel" +architectureToDebianArchString PPC = "powerpc" +architectureToDebianArchString PPC64 = "ppc64el" +architectureToDebianArchString SPARC = "sparc" +architectureToDebianArchString SPARC64 = "sparc64" +architectureToDebianArchString MIPS = "mips" +architectureToDebianArchString MIPSEL = "mipsel" +architectureToDebianArchString MIPS64EL = "mips64el" +architectureToDebianArchString SH4 = "sh" +architectureToDebianArchString IA64 = "ia64" +architectureToDebianArchString S390 = "s390" +architectureToDebianArchString S390X = "s390x" +architectureToDebianArchString ALPHA = "alpha" +architectureToDebianArchString HPPA = "hppa" +architectureToDebianArchString M68K = "m68k" +architectureToDebianArchString ARM64 = "arm64" +architectureToDebianArchString X32 = "x32" type UserName = String diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs index e691f13b..f6551b45 100644 --- a/src/Utility/Exception.hs +++ b/src/Utility/Exception.hs @@ -5,7 +5,7 @@ - License: BSD-2-clause -} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Exception ( @@ -28,6 +28,9 @@ module Utility.Exception ( import Control.Monad.Catch as X hiding (Handler) import qualified Control.Monad.Catch as M import Control.Exception (IOException, AsyncException) +#if MIN_VERSION_base(4,7,0) +import Control.Exception (SomeAsyncException) +#endif import Control.Monad import Control.Monad.IO.Class (liftIO, MonadIO) import System.IO.Error (isDoesNotExistError, ioeGetErrorType) @@ -74,6 +77,9 @@ bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup) catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a catchNonAsync a onerr = a `catches` [ M.Handler (\ (e :: AsyncException) -> throwM e) +#if MIN_VERSION_base(4,7,0) + , M.Handler (\ (e :: SomeAsyncException) -> throwM e) +#endif , M.Handler (\ (e :: SomeException) -> onerr e) ] @@ -1,3 +1,4 @@ +# When updating the resolver here, also update stackResolver in Propellor.DotDir resolver: lts-5.10 packages: - '.' |