diff --git a/CHANGELOG b/CHANGELOG
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,28 @@
+propellor (5.6.0) unstable; urgency=medium
+
+  * withOS had a type level bug that allowed ensureProperty to be used inside
+    it with a Property that does not match the type of the withOS itself.
+    (API change)
+    The fix may cause some of your valid uses of withOS to no longer type
+    check; the best way to work around that is to use pickOS to pick between
+    several properties that are further specialized using withOS.
+    For an example of how to do that, see the source code to
+    Propellor.Property.Borg.installed
+  * Propellor.Property.Cron.runPropellor is a Property DebianLike; it was
+    incorrectly a Property UnixLike before and that wrong type was hidden by
+    the withOS bug.
+  * Some openbsd portability fixes. Thanks, rsiddharth.
+  * Added Libvirt module. Thanks, Sean Whitton.
+  * When bootstrapping on Debian, libghc-stm-dev may not be available,
+    as it's become part of ghc, so check before trying to install it.
+  * Fix build with ghc 8.6.3.
+  * Avoid exposing the constructor of OuterMetaTypesWitness, to avoid
+    the kind of mistake that led to the withOS bug.
+  * Merged Utility changes from git-annex.
+  * Fix --spin crash when ~/.ssh/ directory did not already exist.
+
+ -- Joey Hess <id@joeyh.name>  Fri, 18 Jan 2019 12:11:53 -0400
+
 propellor (5.5.0) unstable; urgency=medium
 
   * letsencrypt': Pass --expand to support expanding the list of domains
diff --git a/Makefile b/Makefile
--- a/Makefile
+++ b/Makefile
@@ -30,8 +30,8 @@
 
 clean:
 	rm -rf dist Setup tags propellor propellor.1 privdata/local
-	find -name \*.o -exec rm {} \;
-	find -name \*.hi -exec rm {} \;
+	find . -name \*.o -exec rm {} \;
+	find . -name \*.hi -exec rm {} \;
 
 # hothasktags chokes on some template haskell etc, so ignore errors
 # duplicate tags with Propellor.Property. removed from the start, as we
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -37,11 +37,11 @@
 ## quick start
 
 1. Get propellor installed on your development machine (ie, laptop).
-     `cabal install propellor`
+     `apt-get install propellor`
           or
-     `stack install propellor`
+     `cabal install propellor`
           or
-     `apt-get install propellor`
+     `cabal unpack propellor; cd propellor-version; stack install`
 2. Run `propellor --init` ; this will set up a `~/.propellor/` git
    repository for you.
 3. Edit `~/.propellor/config.hs`, and add a host you want to manage.
diff --git a/debian/changelog b/debian/changelog
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,28 @@
+propellor (5.6.0) unstable; urgency=medium
+
+  * withOS had a type level bug that allowed ensureProperty to be used inside
+    it with a Property that does not match the type of the withOS itself.
+    (API change)
+    The fix may cause some of your valid uses of withOS to no longer type
+    check; the best way to work around that is to use pickOS to pick between
+    several properties that are further specialized using withOS.
+    For an example of how to do that, see the source code to
+    Propellor.Property.Borg.installed
+  * Propellor.Property.Cron.runPropellor is a Property DebianLike; it was
+    incorrectly a Property UnixLike before and that wrong type was hidden by
+    the withOS bug.
+  * Some openbsd portability fixes. Thanks, rsiddharth.
+  * Added Libvirt module. Thanks, Sean Whitton.
+  * When bootstrapping on Debian, libghc-stm-dev may not be available,
+    as it's become part of ghc, so check before trying to install it.
+  * Fix build with ghc 8.6.3.
+  * Avoid exposing the constructor of OuterMetaTypesWitness, to avoid
+    the kind of mistake that led to the withOS bug.
+  * Merged Utility changes from git-annex.
+  * Fix --spin crash when ~/.ssh/ directory did not already exist.
+
+ -- Joey Hess <id@joeyh.name>  Fri, 18 Jan 2019 12:11:53 -0400
+
 propellor (5.5.0) unstable; urgency=medium
 
   * letsencrypt': Pass --expand to support expanding the list of domains
diff --git a/debian/control b/debian/control
--- a/debian/control
+++ b/debian/control
@@ -4,7 +4,7 @@
 Build-Depends: 
 	debhelper (>= 9),
 	git (>= 2.0),
-	ghc (>= 7.6),
+	ghc (>= 8.4.3),
 	cabal-install,
 	libghc-async-dev,
 	libghc-split-dev,
@@ -16,7 +16,6 @@
 	libghc-mtl-dev,
 	libghc-transformers-dev,
 	libghc-exceptions-dev (>= 0.6),
-	libghc-stm-dev,
 	libghc-text-dev,
 	libghc-hashable-dev,
 Maintainer: Joey Hess <id@joeyh.name>
@@ -28,7 +27,7 @@
 Architecture: any
 Section: admin
 Depends: ${misc:Depends}, ${shlibs:Depends},
-	ghc (>= 7.4),
+	ghc (>= 8.4.3),
 	cabal-install,
 	libghc-async-dev,
 	libghc-split-dev,
@@ -40,7 +39,6 @@
 	libghc-mtl-dev,
 	libghc-transformers-dev,
 	libghc-exceptions-dev (>= 0.6),
-	libghc-stm-dev,
 	libghc-text-dev,
 	libghc-hashable-dev,
 	git (>= 2.0),
diff --git a/doc/README.mdwn b/doc/README.mdwn
--- a/doc/README.mdwn
+++ b/doc/README.mdwn
@@ -37,11 +37,11 @@
 ## quick start
 
 1. Get propellor installed on your development machine (ie, laptop).
-     `cabal install propellor`
+     `apt-get install propellor`
           or
-     `stack install propellor`
+     `cabal install propellor`
           or
-     `apt-get install propellor`
+     `cabal unpack propellor; cd propellor-version; stack install`
 2. Run `propellor --init` ; this will set up a `~/.propellor/` git
    repository for you.
 3. Edit `~/.propellor/config.hs`, and add a host you want to manage.
diff --git a/joeyconfig.hs b/joeyconfig.hs
--- a/joeyconfig.hs
+++ b/joeyconfig.hs
@@ -27,6 +27,7 @@
 import qualified Propellor.Property.Grub as Grub
 import qualified Propellor.Property.Borg as Borg
 import qualified Propellor.Property.Gpg as Gpg
+import qualified Propellor.Property.OpenId as OpenId
 import qualified Propellor.Property.Systemd as Systemd
 import qualified Propellor.Property.Journald as Journald
 import qualified Propellor.Property.Fail2Ban as Fail2Ban
@@ -97,7 +98,7 @@
 clam = host "clam.kitenet.net" $ props
 	& standardSystem (Stable "stretch") X86_64
 		["Unreliable server. Anything here may be lost at any time!" ]
-	& ipv4 "167.114.76.178"
+	& ipv4 "178.33.208.168"
 
 	& User.hasPassword (User "root")
 	& Ssh.hostKeys hostContext
@@ -155,6 +156,9 @@
 	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
 		GitAnnexBuilder.stackAutoBuilder
 		(Stable "jessie") X86_32 (Just "ancient") (Cron.Times "45 * * * *") "2h")
+	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
+		GitAnnexBuilder.standardAutoBuilder
+		Testing ARM64 Nothing (Cron.Times "1 * * * *") "4h")
 
 banana :: Host
 banana = host "banana.kitenet.net" $ props
@@ -181,11 +185,7 @@
 		)
 	& JoeySites.cubieTruckOneWire
 	
-	& Apt.installed ["firmware-misc-nonfree"]
-	& Apt.installed ["firmware-brcm80211"]
-		-- Workaround for https://bugs.debian.org/844056
-		`requires` File.hasPrivContent "/lib/firmware/brcm/brcmfmac43362-sdio.txt" anyContext
-		`requires` File.dirExists "/lib/firmware/brcm"
+	& Apt.installed ["firmware-atheros"]
 	& Apt.serviceInstalledRunning "ntp" -- no hardware clock
 	& bootstrappedFrom GitRepoOutsideChroot
 	& Ssh.hostKeys hostContext
@@ -203,16 +203,12 @@
 	& Postfix.satellite
 
 	& check (not <$> inChroot) (setupRevertableProperty autobuilder)
-	& check (not <$> inChroot) (undoRevertableProperty ancientautobuilder)
 	-- In case compiler needs more than available ram
 	& Apt.serviceInstalledRunning "swapspace"
   where
 	autobuilder = Systemd.nspawned $ GitAnnexBuilder.autoBuilderContainer
 		(GitAnnexBuilder.armAutoBuilder GitAnnexBuilder.standardAutoBuilder)
-		Unstable ARMEL Nothing (Cron.Times "15 15 * * *") "10h"
-	ancientautobuilder = Systemd.nspawned $ GitAnnexBuilder.autoBuilderContainer
-		(GitAnnexBuilder.armAutoBuilder GitAnnexBuilder.stackAutoBuilder)
-		(Stable "jessie") ARMEL (Just "ancient") (Cron.Times "5 15 * * *") "10h"
+		Testing ARMEL Nothing (Cron.Times "15 15 * * *") "10h"
 
 -- This is not a complete description of kite, since it's a
 -- multiuser system with eg, user passwords that are not deployed
@@ -309,6 +305,7 @@
 	& JoeySites.kgbServer
 	
 	& Systemd.nspawned ancientKitenet
+	& Systemd.nspawned openidProvider
 	
 	& alias "podcatcher.kitenet.net"
 	& JoeySites.podcatcher
@@ -486,6 +483,16 @@
 	& standardContainer (Stable "stretch")
 	& alias "shell.olduse.net"
 	& JoeySites.oldUseNetShellBox
+
+-- My own openid provider. Uses php, so containerized for security
+-- and administrative sanity.
+openidProvider :: Systemd.Container
+openidProvider = Systemd.debContainer "openid-provider" $ props
+	& standardContainer (Stable "stretch")
+	& alias hn
+	& OpenId.providerFor [User "joey", User "liw"] hn (Just (Port 8086))
+  where
+	hn = "openid.kitenet.net"
 
 type Motd = [String]
 
diff --git a/propellor.cabal b/propellor.cabal
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
 Name: propellor
-Version: 5.5.0
+Version: 5.6.0
 Cabal-Version: 1.20
 License: BSD2
 Maintainer: Joey Hess <id@joeyh.name>
@@ -101,6 +101,7 @@
     Propellor.Property.Kerberos
     Propellor.Property.Laptop
     Propellor.Property.LetsEncrypt
+    Propellor.Property.Libvirt
     Propellor.Property.List
     Propellor.Property.LightDM
     Propellor.Property.Locale
@@ -199,7 +200,11 @@
     Utility.Data
     Utility.DataUnits
     Utility.Directory
+    Utility.Directory.Stream
+    Utility.Directory.TestDirectory
     Utility.Env
+    Utility.Env.Basic
+    Utility.Env.Set
     Utility.Exception
     Utility.FileMode
     Utility.FileSystemEncoding
@@ -209,10 +214,10 @@
     Utility.Monad
     Utility.Path
     Utility.PartialPrelude
-    Utility.PosixFiles
     Utility.Process
     Utility.Process.Shim
     Utility.Process.NonConcurrent
+    Utility.Process.Transcript
     Utility.SafeCommand
     Utility.Scheduled
     Utility.Scheduled
@@ -221,6 +226,7 @@
     Utility.Table
     Utility.ThreadScheduler
     Utility.Tmp
+    Utility.Tmp.Dir
     Utility.Tuple
     Utility.UserInfo
     System.Console.Concurrent
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -95,6 +95,8 @@
 	go Cabal = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi"
 	go Stack = "if ! stack build --dry-run >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi"
 
+data Dep = Dep String | OldDep String
+
 -- Install build dependencies of propellor, using the specified
 -- Bootstrapper.
 --
@@ -128,32 +130,34 @@
 
 	useapt builder = "apt-get update" : map aptinstall (debdeps builder)
 
-	aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
+	aptinstall (Dep p) = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
+	aptinstall (OldDep p) = "if LANG=C apt-cache policy " ++ p ++ "| grep -q Candidate:; then " ++ aptinstall (Dep p) ++ "; fi"
 	pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
 	pacmaninstall p = "pacman -S --noconfirm --needed " ++ p
 
 	debdeps Cabal =
-		[ "gnupg"
+		[ Dep "gnupg"
 		-- Below are the same deps listed in debian/control.
-		, "ghc"
-		, "cabal-install"
-		, "libghc-async-dev"
-		, "libghc-split-dev"
-		, "libghc-hslogger-dev"
-		, "libghc-unix-compat-dev"
-		, "libghc-ansi-terminal-dev"
-		, "libghc-ifelse-dev"
-		, "libghc-network-dev"
-		, "libghc-mtl-dev"
-		, "libghc-transformers-dev"
-		, "libghc-exceptions-dev"
-		, "libghc-stm-dev"
-		, "libghc-text-dev"
-		, "libghc-hashable-dev"
+		, Dep "ghc"
+		, Dep "cabal-install"
+		, Dep "libghc-async-dev"
+		, Dep "libghc-split-dev"
+		, Dep "libghc-hslogger-dev"
+		, Dep "libghc-unix-compat-dev"
+		, Dep "libghc-ansi-terminal-dev"
+		, Dep "libghc-ifelse-dev"
+		, Dep "libghc-network-dev"
+		, Dep "libghc-mtl-dev"
+		, Dep "libghc-transformers-dev"
+		, Dep "libghc-exceptions-dev"
+		, Dep "libghc-text-dev"
+		, Dep "libghc-hashable-dev"
+		-- Deps that are only needed on old systems.
+		, OldDep "libghc-stm-dev"
 		]
 	debdeps Stack =
-		[ "gnupg"
-		, "haskell-stack"
+		[ Dep "gnupg"
+		, Dep "haskell-stack"
 		]
 
 	fbsddeps Cabal =
@@ -262,8 +266,8 @@
 	-- a binary that is fully built. Also, avoid ever removing
 	-- or breaking the symlink.
 	--
-	-- Need cp -a to make build timestamp checking work.
-	unlessM (boolSystem "cp" [Param "-af", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
+	-- Need cp -pfRL to make build timestamp checking work.
+	unlessM (boolSystem "cp" [Param "-pfRL", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
 		error "cp of binary failed"
 	rename (tmpfor safetycopy) safetycopy
 	symlinkPropellorBin safetycopy
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -7,7 +7,7 @@
 module Propellor.EnsureProperty
 	( ensureProperty
 	, property'
-	, OuterMetaTypesWitness(..)
+	, OuterMetaTypesWitness
 	, Cannot_ensureProperty_WithInfo
 	) where
 
diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs
--- a/src/Propellor/Gpg.hs
+++ b/src/Propellor/Gpg.hs
@@ -13,11 +13,13 @@
 import Propellor.Git.Config
 import Utility.SafeCommand
 import Utility.Process
+import Utility.Process.Transcript
 import Utility.Process.NonConcurrent
 import Utility.Monad
 import Utility.Misc
 import Utility.Tmp
 import Utility.Env
+import Utility.Env.Set
 import Utility.Directory
 import Utility.Split
 import Utility.Exception
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -303,7 +303,8 @@
   where
 	-- This use of getSatisfy is safe, because both a and b
 	-- are added as children, so their info will propigate.
-	c = withOS (getDesc a) $ \_ o ->
+	c = property (getDesc a) $ do
+		o <- getOS
 		if matching o a
 			then maybe (pure NoChange) id (getSatisfy a)
 			else if matching o b
@@ -330,15 +331,9 @@
 withOS
 	:: (SingI metatypes)
 	=> Desc
-	-> (OuterMetaTypesWitness '[] -> Maybe System -> Propellor Result)
+	-> (OuterMetaTypesWitness metatypes -> Maybe System -> Propellor Result)
 	-> Property (MetaTypes metatypes)
-withOS desc a = property desc $ a dummyoutermetatypes =<< getOS
-  where
-	-- Using this dummy value allows ensureProperty to be used
-	-- even though the inner property probably doesn't target everything
-	-- that the outer withOS property targets.
-	dummyoutermetatypes :: OuterMetaTypesWitness ('[])
-	dummyoutermetatypes = OuterMetaTypesWitness sing
+withOS desc a = property' desc $ \w -> a w =<< getOS
 
 -- | A property that always fails with an unsupported OS error.
 unsupportedOS :: Property UnixLike
diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs
--- a/src/Propellor/Property/Borg.hs
+++ b/src/Propellor/Property/Borg.hs
@@ -59,12 +59,15 @@
 	go (UsesEnvVar (k, v)) = (k, v)
 
 installed :: Property DebianLike
-installed = withOS desc $ \w o -> case o of
-	(Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $
-		Apt.backportInstalled ["borgbackup", "python3-msgpack"]
-	_ -> ensureProperty w $
-		Apt.installed ["borgbackup"]
+installed = pickOS installdebian aptinstall
   where
+	installdebian :: Property Debian
+	installdebian = withOS desc $ \w o -> case o of
+		(Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $
+			Apt.backportInstalled ["borgbackup", "python3-msgpack"]
+		_ -> ensureProperty w $
+			Apt.installed ["borgbackup"]
+	aptinstall = Apt.installed ["borgbackup"] `describe` desc
         desc = "installed borgbackup"
 
 repoExists :: BorgRepo -> IO Bool
diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs
--- a/src/Propellor/Property/Cron.hs
+++ b/src/Propellor/Property/Cron.hs
@@ -79,7 +79,7 @@
 	("nice ionice -c 3 sh -c " ++ shellEscape command)
 
 -- | Installs a cron job to run propellor.
-runPropellor :: Times -> Property UnixLike
+runPropellor :: Times -> Property DebianLike
 runPropellor times = withOS "propellor cron job" $ \w o -> do
 	bootstrapper <- getBootstrapper
 	ensureProperty w $
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -17,6 +17,7 @@
 	imageRebuiltFor,
 	imageBuiltFrom,
 	imageExists,
+	imageChrootNotPresent,
 	GrubTarget(..),
 	noBootloader,
 ) where
@@ -200,14 +201,13 @@
 		`describe` desc
   where
 	desc = "built disk image " ++ describeDiskImage img
-	RawDiskImage imgfile = rawDiskImage img
 	cleanrebuild :: Property Linux
 	cleanrebuild
 		| rebuild = property desc $ do
 			liftIO $ removeChroot chrootdir
 			return MadeChange
 		| otherwise = doNothing
-	chrootdir = imgfile ++ ".chroot"
+	chrootdir = imageChroot img
 	chroot =
 		let c = propprivdataonly $ mkchroot chrootdir
 		in setContainerProps c $ containerProps c
@@ -378,7 +378,7 @@
 imageExists' dest@(RawDiskImage img) parttable = (setup <!> cleanup) `describe` desc
   where
 	desc = "disk image exists " ++ img
-	parttablefile = img ++ ".parttable"
+	parttablefile = imageParttableFile dest
 	setup = property' desc $ \w -> do
 		oldparttable <- liftIO $ catchDefaultIO "" $ readFileStrict parttablefile
 		res <- ensureProperty w $ imageExists dest (partTableSize parttable)
@@ -487,6 +487,24 @@
 
 noBootloaderFinalized :: Finalization
 noBootloaderFinalized _img _mnt _loopDevs = doNothing
+
+imageChrootNotPresent :: DiskImage d => d -> Property UnixLike
+imageChrootNotPresent img = check (doesDirectoryExist dir) $
+	property "destroy the chroot used to build the image" $ makeChange $ do
+		removeChroot dir
+		nukeFile $ imageParttableFile img
+  where
+	dir = imageChroot img
+
+imageChroot :: DiskImage d => d -> FilePath
+imageChroot img = imgfile <.> "chroot"
+  where
+	RawDiskImage imgfile = rawDiskImage img
+
+imageParttableFile :: DiskImage d => d -> FilePath
+imageParttableFile img = imgfile <.> "parttable"
+  where
+	RawDiskImage imgfile = rawDiskImage img
 
 isChild :: FilePath -> Maybe MountPoint -> Bool
 isChild mntpt (Just d)
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -17,7 +17,6 @@
 	IPWithMask(..),
 ) where
 
-import Data.Monoid
 import qualified Data.Semigroup as Sem
 import Data.Char
 import Data.List
diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs
new file mode 100644
--- /dev/null
+++ b/src/Propellor/Property/Libvirt.hs
@@ -0,0 +1,210 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+module Propellor.Property.Libvirt (
+	NumVCPUs(..),
+	MiBMemory(..),
+	AutoStart(..),
+	DiskImageType(..),
+	installed,
+	defaultNetworkAutostarted,
+	defaultNetworkStarted,
+	defined,
+) where
+
+import Propellor.Base
+import Propellor.Types.Info
+import Propellor.Property.Chroot
+import Propellor.Property.DiskImage
+import qualified Propellor.Property.Apt as Apt
+
+import Utility.Split
+
+-- | The number of virtual CPUs to assign to the virtual machine
+newtype NumVCPUs = NumVCPUs Int
+
+-- | The number of MiB of memory to assign to the virtual machine
+newtype MiBMemory = MiBMemory Int
+
+-- | Whether the virtual machine should be started after it is defined, and at
+-- host system boot
+data AutoStart = AutoStart | NoAutoStart
+
+-- | Which type of disk image to build for the virtual machine
+data DiskImageType = Raw -- | QCow2
+
+-- | Install basic libvirt components
+installed :: Property DebianLike
+installed = Apt.installed ["libvirt-clients", "virtinst"]
+
+-- | Ensure that the default libvirt network is set to autostart, and start it.
+--
+-- On Debian, it is not started by default after installation of libvirt.
+defaultNetworkAutostarted :: Property DebianLike
+defaultNetworkAutostarted = autostarted
+	`requires` installed
+	`before` defaultNetworkStarted
+  where
+	autostarted = check (not <$> doesFileExist autostartFile) $
+		cmdProperty "virsh" ["net-autostart", "default"]
+	autostartFile = "/etc/libvirt/qemu/networks/autostart/default.xml"
+
+-- | Ensure that the default libvirt network is started.
+defaultNetworkStarted :: Property DebianLike
+defaultNetworkStarted =	go `requires` installed
+  where
+	go :: Property UnixLike
+	go = property "start libvirt's default network" $ do
+		runningNetworks <- liftIO $ virshGetColumns ["net-list"]
+		if ["default"] `elem` (take 1 <$> runningNetworks)
+			then noChange
+			else makeChange $ unlessM startIt $
+				errorMessage "failed to start default network"
+	startIt = boolSystem "virsh" [Param "net-start", Param "default"]
+
+
+-- | Builds a disk image with the properties of the given Host, installs a
+-- libvirt configuration file to boot the image, and if it is set to autostart,
+-- start the VM.
+--
+-- Note that building the disk image happens only once.  So if you change the
+-- properties of the given Host, this property will not modify the disk image.
+-- In order to later apply properties to the VM, you should spin it directly, or
+-- arrange to have it spun with a property like 'Cron.runPropellor', or use
+-- 'Propellor.Property.Conductor' from the VM host.
+--
+-- Suggested usage in @config.hs@:
+--
+-- > mybox = host "mybox.example.com" $ props
+-- > 	& osDebian (Stable "stretch") X86_64
+-- > 	& Libvirt.defaultNetworkAutostarted
+-- > 	& Libvirt.defined Libvirt.Raw
+-- > 		(Libvirt.MiBMemory 2048) (Libvirt.NumVCPUs 2)
+-- > 		Libvirt.NoAutoStart subbox
+-- >
+-- > subbox = host "subbox.mybox.example.com" $ props
+-- > 	& osDebian Unstable X86_64
+-- > 	& hasPartition
+-- > 		( partition EXT4
+-- > 			`mountedAt` "/"
+-- > 			`addFreeSpace` MegaBytes 10240
+-- > 		)
+-- > 	& Apt.installed ["linux-image-amd64"]
+-- > 	& Grub.installed PC
+-- >
+-- > 	& ipv4 "192.168.122.31"
+-- > 	& Network.static "ens3" (IPv4 "192.168.122.31")
+-- > 		(Just (Network.Gateway (IPv4 "192.168.122.1")))
+-- > 		`requires` Network.cleanInterfacesFile
+-- > 	& Hostname.sane
+defined
+	:: DiskImageType
+	-> MiBMemory
+	-> NumVCPUs
+	-> AutoStart
+	-> Host
+	-> Property (HasInfo + DebianLike)
+defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h =
+	(built `before` nuked `before` xmlDefined `before` started)
+	`requires` installed
+  where
+	built :: Property (HasInfo + DebianLike)
+	built = check (not <$> doesFileExist imageLoc) $
+		setupRevertableProperty $ imageBuiltFor h
+			(image) (Debootstrapped mempty)
+
+	nuked :: Property UnixLike
+	nuked = imageChrootNotPresent image
+
+	xmlDefined :: Property UnixLike
+	xmlDefined = check (not <$> doesFileExist conf) $
+		property "define the libvirt VM" $
+		withTmpFile (hostName h) $ \t fh -> do
+			xml <- liftIO $ readProcess "virt-install" $
+				[ "-n", hostName h
+				, "--memory=" ++ show mem
+				, "--vcpus=" ++ show cpus
+				, "--disk"
+				, "path=" ++ imageLoc
+					++ ",device=disk,bus=virtio"
+				, "--print-xml"
+				] ++ autoStartArg ++ osVariantArg
+			liftIO $ hPutStrLn fh xml
+			liftIO $ hClose fh
+			makeChange $ unlessM (defineIt t) $
+				errorMessage "failed to define VM"
+	  where
+		defineIt t = boolSystem "virsh" [Param "define", Param t]
+
+	started :: Property UnixLike
+	started = case auto of
+		AutoStart -> property "start the VM" $ do
+			runningVMs <- liftIO $ virshGetColumns ["list"]
+			-- From the point of view of `virsh start`, the "State"
+			-- column in the output of `virsh list` is not relevant.
+			-- So long as the VM is listed, it's considered started.
+			if [hostName h] `elem` (take 1 . drop 1 <$> runningVMs)
+				then noChange
+				else makeChange $ unlessM startIt $
+					errorMessage "failed to start VM"
+		NoAutoStart -> doNothing
+	  where
+		startIt = boolSystem "virsh" [Param "start", Param $ hostName h]
+
+	image = case imageType of
+		Raw -> RawDiskImage imageLoc
+	imageLoc =
+		"/var/lib/libvirt/images" </> hostName h <.> case imageType of
+			Raw -> "img"
+	conf = "/etc/libvirt/qemu" </> hostName h <.> "xml"
+
+	osVariantArg = maybe [] (\v -> ["--os-variant=" ++ v]) $ osVariant h
+	autoStartArg = case auto of
+		AutoStart -> ["--autostart"]
+		NoAutoStart -> []
+
+-- ==== utility functions ====
+
+-- The --os-variant property is optional, per virt-install(1), so return Nothing
+-- if there isn't a known correct value.  The VM will still be defined.  Pass
+-- the value if we can, though, to optimise the generated XML for the host's OS
+osVariant :: Host -> Maybe String
+osVariant h = hostSystem h >>= \s -> case s of
+	System (Debian _ (Stable "jessie")) _ -> Just "debian8"
+	System (Debian _ (Stable "stretch")) _ -> Just "debian9"
+	System (Debian _ Testing) _ -> Just "debiantesting"
+	System (Debian _ Unstable) _ -> Just "debiantesting"
+
+	System (Buntish "trusty") _ -> Just "ubuntu14.04"
+	System (Buntish "utopic") _ -> Just "ubuntu14.10"
+	System (Buntish "vivid") _ -> Just "ubuntu15.04"
+	System (Buntish "wily") _ -> Just "ubuntu15.10"
+	System (Buntish "xenial") _ -> Just "ubuntu16.04"
+	System (Buntish "yakkety") _ -> Just "ubuntu16.10"
+	System (Buntish "zesty") _ -> Just "ubuntu17.04"
+	System (Buntish "artful") _ -> Just "ubuntu17.10"
+	System (Buntish "bionic") _ -> Just "ubuntu18.04"
+
+	System (FreeBSD (FBSDProduction FBSD101)) _ -> Just "freebsd10.1"
+	System (FreeBSD (FBSDProduction FBSD102)) _ -> Just "freebsd10.2"
+	System (FreeBSD (FBSDProduction FBSD093)) _ -> Just "freebsd9.3"
+	System (FreeBSD (FBSDLegacy FBSD101)) _ -> Just "freebsd10.1"
+	System (FreeBSD (FBSDLegacy FBSD102)) _ -> Just "freebsd10.2"
+	System (FreeBSD (FBSDLegacy FBSD093)) _ -> Just "freebsd9.3"
+
+	-- libvirt doesn't have an archlinux variant yet, it seems
+	System ArchLinux _ -> Nothing
+
+	-- other stable releases that we don't know about (since there are
+	-- infinitely many possible stable release names, as it is a freeform
+	-- string, we need this to avoid a compiler warning)
+	System (Debian _ _) _ -> Nothing
+	System (Buntish _) _ -> Nothing
+
+-- Run a virsh command with the given list of arguments, that is expected to
+-- yield tabular output, and return the rows
+virshGetColumns :: [String] -> IO [[String]]
+virshGetColumns args = map (filter (not . null) . split " ") . drop 2 . lines
+ 	<$> readProcess "virsh" args
+
+hostSystem :: Host -> Maybe System
+hostSystem = fromInfoVal . fromInfo . hostInfo
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -122,9 +122,9 @@
 		& Apt.stdSourcesList
 		& Apt.unattendedUpgrades
 		& Apt.cacheCleaned
-		& buildDepsApt
 		& User.accountFor (User builduser)
 		& tree (architectureToDebianArchString arch) flavor
+		& buildDepsApt
 
 stackAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
 stackAutoBuilder suite arch flavor =
@@ -140,7 +140,7 @@
 		-- Workaround https://github.com/commercialhaskell/stack/issues/2093
 		& Apt.installed ["libtinfo-dev"]
 
-stackInstalled :: Property Linux
+stackInstalled :: Property DebianLike
 stackInstalled = withOS "stack installed" $ \w o ->
 	case o of
 		(Just (System (Debian Linux (Stable "jessie")) arch)) ->
@@ -182,6 +182,7 @@
 	propertyList "arm git-annex autobuilder" $ props
 		& baseautobuilder suite arch flavor
 		-- Works around ghc crash with parallel builds on arm.
+		& File.dirExists (homedir </> ".cabal")
 		& (homedir </> ".cabal" </> "config")
 			`File.containsLine` "jobs: 1"
 		-- Work around https://github.com/systemd/systemd/issues/7135
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -400,23 +400,31 @@
 	"xargs git-annex importfeed -c annex.genmetadata=true < feeds; mr --quiet update"
 	`requires` Apt.installed ["git-annex", "myrepos"]
 
-kiteMailServer :: Property (HasInfo + DebianLike)
-kiteMailServer = propertyList "kitenet.net mail server" $ props
-	& Postfix.installed
-	& Apt.installed ["postfix-pcre"]
-	& Apt.serviceInstalledRunning "postgrey"
+spamdEnabled :: Property DebianLike
+spamdEnabled = tightenTargets $ 
+	cmdProperty "update-rc.d" ["spamassassin", "enable"]
+		`assume` MadeChange
 
+spamassassinConfigured :: Property DebianLike
+spamassassinConfigured = propertyList "spamassassin configured" $ props
 	& Apt.serviceInstalledRunning "spamassassin"
 	& "/etc/default/spamassassin" `File.containsLines`
 		[ "# Propellor deployed"
-		, "ENABLED=1"
 		, "OPTIONS=\"--create-prefs --max-children 5 --helper-home-dir\""
 		, "CRON=1"
 		, "NICE=\"--nicelevel 15\""
-		] `onChange` Service.restarted "spamassassin"
-		`describe` "spamd enabled"
+		]
+		`describe` "spamd configured"
+		`onChange` spamdEnabled
+		`onChange` Service.restarted "spamassassin"
 		`requires` Apt.serviceInstalledRunning "cron"
 
+kiteMailServer :: Property (HasInfo + DebianLike)
+kiteMailServer = propertyList "kitenet.net mail server" $ props
+	& Postfix.installed
+	& Apt.installed ["postfix-pcre"]
+	& Apt.serviceInstalledRunning "postgrey"
+	& spamassassinConfigured
 	& Apt.serviceInstalledRunning "spamass-milter"
 	-- Add -m to prevent modifying messages Subject or body.
 	& "/etc/default/spamass-milter" `File.containsLine`
@@ -585,10 +593,18 @@
 	& "/etc/pine.conf" `File.hasContent`
 		[ "# deployed with propellor"
 		, "inbox-path={localhost}inbox"
-		, "rsh-command=/usr/lib/dovecot/imap"
+		, "rsh-command=" ++ imapalpinescript
 		]
 		`describe` "pine configured to use local imap server"
-
+	& imapalpinescript `File.hasContent`
+		[ "#!/bin/sh"
+		, "# deployed with propellor"
+		, "set -e"
+		, "exec /usr/lib/dovecot/imap 2>/dev/null"
+		]
+		`onChange` (imapalpinescript `File.mode`
+			combineModes (readModes ++ executeModes))
+		`describe` "imap script for pine"
 	& Apt.serviceInstalledRunning "mailman"
 	-- Override the default http url. (Only affects new lists.)
 	& "/etc/mailman/mm_cfg.py" `File.containsLine`
@@ -600,6 +616,7 @@
   where
 	ctx = Context "kitenet.net"
 	pinescript = "/usr/local/bin/pine"
+	imapalpinescript = "/usr/local/bin/imap-for-alpine"
 	dovecotusers = "/etc/dovecot/users"
 
 	ssmtp = Postfix.Service
@@ -806,7 +823,7 @@
 		, "RewriteRule /~anna/.* http://waldeneffect\\.org/ [R]"
 		, "RewriteRule /~anna/.* http://waldeneffect\\.org/ [R]"
 		, "RewriteRule /~anna http://waldeneffect\\.org/ [R]"
-		, "RewriteRule /simpleid/ http://openid.kitenet.net:8081/simpleid/"
+		, "RewriteRule /simpleid/ http://openid.kitenet.net:8086/simpleid/"
 		, "# Even the kite home page is not here any more!"
 		, "RewriteRule ^/$ http://www.kitenet.net/ [R]"
 		, "RewriteRule ^/index.html http://www.kitenet.net/ [R]"
@@ -937,7 +954,6 @@
 		`requires` Apt.installed
 			[ "ghc", "cabal-install", "make"
 			, "libghc-http-types-dev"
-			, "libghc-stm-dev"
 			, "libghc-aeson-dev"
 			, "libghc-wai-dev"
 			, "libghc-warp-dev"
@@ -1016,13 +1032,17 @@
 	-- rsync server command to be updated too.
 	rsynccommand = "rsync -e 'ssh -i" ++ sshkeyfile ++ "' -avz rrds/ joey@kitenet.net:/srv/web/homepower.joeyh.name/rrds/"
 
+homerouterWifiInterfaceOld :: String
+homerouterWifiInterfaceOld = "wlx00c0ca82eb78" -- thinkpenguin wifi adapter
+
 homerouterWifiInterface :: String
-homerouterWifiInterface = "wlan0" -- "wlx7cdd90400448" is a wifi dongle
+homerouterWifiInterface = "wlx7cdd90400448" -- small wifi dongle
 
 -- My home router, running hostapd and dnsmasq,
 -- with eth0 connected to a satellite modem, and a fallback ppp connection.
 homeRouter :: Property (HasInfo + DebianLike)
 homeRouter = propertyList "home router" $ props
+	& File.notPresent (Network.interfaceDFile homerouterWifiInterfaceOld)
 	& Network.static homerouterWifiInterface (IPv4 "10.1.1.1") Nothing
 		`requires` Network.cleanInterfacesFile
 	& Apt.installed ["hostapd"]
@@ -1134,6 +1154,8 @@
 	, "yeahconsole", "xkbset", "xinput"
 	, "assword", "pumpa"
 	, "vorbis-tools", "audacity"
+	, "ekiga"
+	, "bluez-firmware", "blueman", "pulseaudio-module-bluetooth"
 	, "xul-ext-ublock-origin", "xul-ext-pdf.js", "xul-ext-status4evar"
 	, "vim-syntastic", "vim-fugitive"
 	, "adb", "gthumb"
@@ -1203,15 +1225,17 @@
 	& Apt.installed ["uhubctl"]
 	& "/etc/udev/rules.d/52-startech-hub.rules" `File.hasContent`
 		[ "# let users power control startech hub with uhubctl"
-		, "ATTR{idVendor}==\"0409\", ATTR{idProduct}==\"005a\", MODE=\"0666\""
+		, "ATTR{idVendor}==\"" ++ hubvendor ++ "\", ATTR{idProduct}==\"005a\", MODE=\"0666\""
 		]
-	& autoMountDrive "archive-10" (USBHubPort 1) (Just "archive-older")
-	& autoMountDrive "archive-11" (USBHubPort 2) (Just "archive-old")
-	& autoMountDrive "archive-12" (USBHubPort 3) (Just "archive")
-	& autoMountDrive "passport" (USBHubPort 4) Nothing
+	& autoMountDrive "archive-10" (USBHubPort hubvendor 1) (Just "archive-older")
+	& autoMountDrive "archive-11" (USBHubPort hubvendor 2) (Just "archive-old")
+	& autoMountDrive "archive-12" (USBHubPort hubvendor 3) (Just "archive")
+	& autoMountDrive "passport" (USBHubPort hubvendor 4) Nothing
 	& Apt.installed ["git-annex", "borgbackup"]
+  where
+	hubvendor = "0409"
 
-newtype USBHubPort = USBHubPort Int
+data USBHubPort = USBHubPort String Int
 
 -- Makes a USB drive with the given label automount, and unmount after idle
 -- for a while.
@@ -1219,7 +1243,7 @@
 -- The hub port is turned on and off automatically as needed, using
 -- uhubctl.
 autoMountDrive :: Mount.Label -> USBHubPort -> Maybe FilePath -> Property DebianLike
-autoMountDrive label (USBHubPort port) malias = propertyList desc $ props
+autoMountDrive label (USBHubPort hubvendor port) malias = propertyList desc $ props
 	& File.ownerGroup mountpoint (User "joey") (Group "joey")
 		`requires` File.dirExists mountpoint
 	& case malias of
@@ -1248,8 +1272,8 @@
 		, "[Service]"
 		, "Type=oneshot"
 		, "RemainAfterExit=true"
-		, "ExecStart=/usr/sbin/uhubctl -a on -p " ++ show port
-		, "ExecStop=/bin/sh -c 'uhubctl -a off -p " ++ show port ++
+		, "ExecStart=/usr/sbin/uhubctl -a on -p " ++ show port ++ " --vendor " ++ hubvendor 
+		, "ExecStop=/bin/sh -c 'uhubctl -a off -p " ++ show port ++ " --vendor " ++ hubvendor
 			-- Powering off the port does not remove device
 			-- files, so ask udev to remove the devfile; it will
 			-- be added back after the drive next spins up
@@ -1257,7 +1281,7 @@
 			-- spun up.
 			-- (This only works when the devfile is in
 			-- by-label.)
-			"; udevadm trigger --action=remove " ++ devfile ++ " || true'"
+			++ "; udevadm trigger --action=remove " ++ devfile ++ " || true'"
 		, "[Install]"
 		, "WantedBy="
 		]
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -204,13 +204,18 @@
 
 -- | Ensures machined and machinectl are installed
 machined :: Property Linux
-machined = withOS "machined installed" $ \w o ->
-	case o of
-		-- Split into separate debian package since systemd 225.
-		(Just (System (Debian _ suite) _))
-			| not (isStable suite) || suite == (Stable "stretch") ->
-				ensureProperty w $ Apt.installed ["systemd-container"]
-		_ -> noChange
+machined = installeddebian `pickOS` assumeinstalled
+  where
+	installeddebian :: Property DebianLike
+	installeddebian = withOS "machined installed" $ \w o ->
+		case o of
+			-- Split into separate debian package since systemd 225.
+			(Just (System (Debian _ suite) _))
+				| not (isStable suite) || suite == (Stable "stretch") ->
+					ensureProperty w $ Apt.installed ["systemd-container"]
+			_ -> noChange
+	assumeinstalled :: Property Linux
+	assumeinstalled = doNothing
 
 -- | Defines a container with a given machine name,
 -- and how to create its chroot if not already present.
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -168,7 +168,7 @@
 	existinggroups <- map (fst . break (== ':')) . lines
 		<$> liftIO (readFile "/etc/group")
 	let toadd = filter (`elem` existinggroups) desktopgroups
-	ensureProperty o $ propertyList desc $ toProps $
+	ensureProperty o $ combineProperties desc $ toProps $
 		map (hasGroup user . Group) toadd
   where
 	desc = "user " ++ u ++ " is in standard desktop groups"
diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs
--- a/src/Propellor/Ssh.hs
+++ b/src/Propellor/Ssh.hs
@@ -19,7 +19,7 @@
 sshCachingParams hn = do
 	home <- myHomeDir
 	let socketfile = socketFile home hn
-	createDirectoryIfMissing False (takeDirectory socketfile)
+	createDirectoryIfMissing True (takeDirectory socketfile)
 	let ps =
 		[ Param "-o"
 		, Param ("ControlPath=" ++ socketfile)
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -23,7 +23,7 @@
 
 import Propellor.Types.ConfigurableValue
 
-import Network.BSD (HostName)
+import Network.Socket (HostName)
 import Data.Typeable
 import Data.String
 
diff --git a/src/Propellor/Types/Singletons.hs b/src/Propellor/Types/Singletons.hs
--- a/src/Propellor/Types/Singletons.hs
+++ b/src/Propellor/Types/Singletons.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, DataKinds, PolyKinds, TypeOperators, TypeFamilies, GADTs, UndecidableInstances #-}
+{-# LANGUAGE CPP, DataKinds, PolyKinds, TypeOperators, TypeFamilies, GADTs, FlexibleContexts #-}
 
 -- | Simple implementation of singletons, portable back to ghc 7.6.3
 
diff --git a/src/Propellor/Utilities.hs b/src/Propellor/Utilities.hs
--- a/src/Propellor/Utilities.hs
+++ b/src/Propellor/Utilities.hs
@@ -9,19 +9,27 @@
 module Propellor.Utilities (
 	  module Utility.PartialPrelude
 	, module Utility.Process
+	, module Utility.Process.Transcript
 	, module Utility.Exception
 	, module Utility.Env
+	, module Utility.Env.Set
 	, module Utility.Directory
+	, module Utility.Directory.TestDirectory
 	, module Utility.Tmp
+	, module Utility.Tmp.Dir
 	, module Utility.Monad
 	, module Utility.Misc
 ) where
 
 import Utility.PartialPrelude
 import Utility.Process
+import Utility.Process.Transcript
 import Utility.Exception
 import Utility.Env
+import Utility.Env.Set
 import Utility.Directory
+import Utility.Directory.TestDirectory
 import Utility.Tmp
+import Utility.Tmp.Dir
 import Utility.Monad
 import Utility.Misc
diff --git a/src/Utility/Directory.hs b/src/Utility/Directory.hs
--- a/src/Utility/Directory.hs
+++ b/src/Utility/Directory.hs
@@ -16,22 +16,18 @@
 import System.IO.Error
 import Control.Monad
 import System.FilePath
+import System.PosixCompat.Files
 import Control.Applicative
-import Control.Concurrent
 import System.IO.Unsafe (unsafeInterleaveIO)
 import Data.Maybe
 import Prelude
 
-#ifdef mingw32_HOST_OS
-import qualified System.Win32 as Win32
-#else
-import qualified System.Posix as Posix
+#ifndef mingw32_HOST_OS
 import Utility.SafeCommand
 import Control.Monad.IfElse
 #endif
 
 import Utility.SystemDirectory
-import Utility.PosixFiles
 import Utility.Tmp
 import Utility.Exception
 import Utility.Monad
@@ -42,10 +38,6 @@
 dirCruft ".." = True
 dirCruft _ = False
 
-fsCruft :: FilePath -> Bool
-fsCruft "lost+found" = True
-fsCruft d = dirCruft d
-
 {- Lists the contents of a directory.
  - Unlike getDirectoryContents, paths are not relative to the directory. -}
 dirContents :: FilePath -> IO [FilePath]
@@ -100,10 +92,10 @@
 	go c (dir:dirs)
 		| skipdir (takeFileName dir) = go c dirs
 		| otherwise = unsafeInterleaveIO $ do
-			subdirs <- go c
+			subdirs <- go []
 				=<< filterM (isDirectory <$$> getSymbolicLinkStatus)
 				=<< catchDefaultIO [] (dirContents dir)
-			go (subdirs++[dir]) dirs
+			go (subdirs++dir:c) dirs
 
 {- Moves one filename to another.
  - First tries a rename, but falls back to moving across devices if needed. -}
@@ -162,101 +154,3 @@
 #else
 	go = removeFile file
 #endif
-
-#ifndef mingw32_HOST_OS
-data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream
-#else
-data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())
-#endif
-
-type IsOpen = MVar () -- full when the handle is open
-
-openDirectory :: FilePath -> IO DirectoryHandle
-openDirectory path = do
-#ifndef mingw32_HOST_OS
-	dirp <- Posix.openDirStream path
-	isopen <- newMVar ()
-	return (DirectoryHandle isopen dirp)
-#else
-	(h, fdat) <- Win32.findFirstFile (path </> "*")
-	-- Indicate that the fdat contains a filename that readDirectory
-	-- has not yet returned, by making the MVar be full.
-	-- (There's always at least a "." entry.)
-	alreadyhave <- newMVar ()
-	isopen <- newMVar ()
-	return (DirectoryHandle isopen h fdat alreadyhave)
-#endif
-
-closeDirectory :: DirectoryHandle -> IO ()
-#ifndef mingw32_HOST_OS
-closeDirectory (DirectoryHandle isopen dirp) =
-	whenOpen isopen $
-		Posix.closeDirStream dirp
-#else
-closeDirectory (DirectoryHandle isopen h _ alreadyhave) =
-	whenOpen isopen $ do
-		_ <- tryTakeMVar alreadyhave
-		Win32.findClose h
-#endif
-  where
-	whenOpen :: IsOpen -> IO () -> IO ()
-	whenOpen mv f = do
-		v <- tryTakeMVar mv
-		when (isJust v) f
-
-{- |Reads the next entry from the handle. Once the end of the directory
-is reached, returns Nothing and automatically closes the handle.
--}
-readDirectory :: DirectoryHandle -> IO (Maybe FilePath)
-#ifndef mingw32_HOST_OS
-readDirectory hdl@(DirectoryHandle _ dirp) = do
-	e <- Posix.readDirStream dirp
-	if null e
-		then do
-			closeDirectory hdl
-			return Nothing
-		else return (Just e)
-#else
-readDirectory hdl@(DirectoryHandle _ h fdat mv) = do
-	-- If the MVar is full, then the filename in fdat has
-	-- not yet been returned. Otherwise, need to find the next
-	-- file.
-	r <- tryTakeMVar mv
-	case r of
-		Just () -> getfn
-		Nothing -> do
-			more <- Win32.findNextFile h fdat
-			if more
-				then getfn
-				else do
-					closeDirectory hdl
-					return Nothing
-  where
-	getfn = do
-		filename <- Win32.getFindDataFileName fdat
-		return (Just filename)
-#endif
-
--- True only when directory exists and contains nothing.
--- Throws exception if directory does not exist.
-isDirectoryEmpty :: FilePath -> IO Bool
-isDirectoryEmpty d = testDirectory d dirCruft
-
--- | True if the directory does not exist or contains nothing.
--- Ignores "lost+found" which can exist in an empty filesystem.
-isUnpopulated :: FilePath -> IO Bool
-isUnpopulated d = catchDefaultIO True $ testDirectory d fsCruft
-
--- | Run test on entries found in directory, return False as soon as the
--- test returns False, else return True.  Throws exception if directory does
--- not exist.
-testDirectory :: FilePath -> (FilePath -> Bool) -> IO Bool
-testDirectory d test = bracket (openDirectory d) closeDirectory check
-  where
-	check h = do
-		v <- readDirectory h
-		case v of
-			Nothing -> return True
-			Just f
-				| not (test f) -> return False
-				| otherwise -> check h
diff --git a/src/Utility/Directory/Stream.hs b/src/Utility/Directory/Stream.hs
new file mode 100644
--- /dev/null
+++ b/src/Utility/Directory/Stream.hs
@@ -0,0 +1,130 @@
+{- streaming directory traversal
+ -
+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Directory.Stream where
+
+import Control.Monad
+import System.FilePath
+import System.IO.Unsafe (unsafeInterleaveIO)
+import Control.Concurrent
+import Data.Maybe
+import Prelude
+
+#ifdef mingw32_HOST_OS
+import qualified System.Win32 as Win32
+#else
+import qualified System.Posix as Posix
+#endif
+
+import Utility.Directory
+import Utility.Exception
+
+#ifndef mingw32_HOST_OS
+data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream
+#else
+data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())
+#endif
+
+type IsOpen = MVar () -- full when the handle is open
+
+openDirectory :: FilePath -> IO DirectoryHandle
+openDirectory path = do
+#ifndef mingw32_HOST_OS
+	dirp <- Posix.openDirStream path
+	isopen <- newMVar ()
+	return (DirectoryHandle isopen dirp)
+#else
+	(h, fdat) <- Win32.findFirstFile (path </> "*")
+	-- Indicate that the fdat contains a filename that readDirectory
+	-- has not yet returned, by making the MVar be full.
+	-- (There's always at least a "." entry.)
+	alreadyhave <- newMVar ()
+	isopen <- newMVar ()
+	return (DirectoryHandle isopen h fdat alreadyhave)
+#endif
+
+closeDirectory :: DirectoryHandle -> IO ()
+#ifndef mingw32_HOST_OS
+closeDirectory (DirectoryHandle isopen dirp) =
+	whenOpen isopen $
+		Posix.closeDirStream dirp
+#else
+closeDirectory (DirectoryHandle isopen h _ alreadyhave) =
+	whenOpen isopen $ do
+		_ <- tryTakeMVar alreadyhave
+		Win32.findClose h
+#endif
+  where
+	whenOpen :: IsOpen -> IO () -> IO ()
+	whenOpen mv f = do
+		v <- tryTakeMVar mv
+		when (isJust v) f
+
+-- | Reads the next entry from the handle. Once the end of the directory
+-- is reached, returns Nothing and automatically closes the handle.
+readDirectory :: DirectoryHandle -> IO (Maybe FilePath)
+#ifndef mingw32_HOST_OS
+readDirectory hdl@(DirectoryHandle _ dirp) = do
+	e <- Posix.readDirStream dirp
+	if null e
+		then do
+			closeDirectory hdl
+			return Nothing
+		else return (Just e)
+#else
+readDirectory hdl@(DirectoryHandle _ h fdat mv) = do
+	-- If the MVar is full, then the filename in fdat has
+	-- not yet been returned. Otherwise, need to find the next
+	-- file.
+	r <- tryTakeMVar mv
+	case r of
+		Just () -> getfn
+		Nothing -> do
+			more <- Win32.findNextFile h fdat
+			if more
+				then getfn
+				else do
+					closeDirectory hdl
+					return Nothing
+  where
+	getfn = do
+		filename <- Win32.getFindDataFileName fdat
+		return (Just filename)
+#endif
+
+-- | Like getDirectoryContents, but rather than buffering the whole
+-- directory content in memory, lazily streams.
+--
+-- This is like lazy readFile in that the handle to the directory remains
+-- open until the whole list is consumed, or until the list is garbage
+-- collected. So use with caution particularly when traversing directory
+-- trees.
+streamDirectoryContents :: FilePath -> IO [FilePath]
+streamDirectoryContents d = openDirectory d >>= collect
+  where
+	collect hdl = readDirectory hdl >>= \case
+		Nothing -> return []
+		Just f -> do
+			rest <- unsafeInterleaveIO (collect hdl)
+			return (f:rest)
+
+-- | True only when directory exists and contains nothing.
+-- Throws exception if directory does not exist.
+isDirectoryEmpty :: FilePath -> IO Bool
+isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check
+  where
+	check h = do
+		v <- readDirectory h
+		case v of
+			Nothing -> return True
+			Just f
+				| not (dirCruft f) -> return False
+				| otherwise -> check h
diff --git a/src/Utility/Directory/TestDirectory.hs b/src/Utility/Directory/TestDirectory.hs
new file mode 100644
--- /dev/null
+++ b/src/Utility/Directory/TestDirectory.hs
@@ -0,0 +1,40 @@
+{- testing properties of directories
+ -
+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+module Utility.Directory.TestDirectory where
+
+import Utility.Directory
+import Utility.Directory.Stream
+import Utility.Exception
+
+-- | True only when directory exists and contains nothing.
+-- Throws exception if directory does not exist.
+isDirectoryEmpty :: FilePath -> IO Bool
+isDirectoryEmpty d = testDirectory d dirCruft
+
+-- | True if the directory does not exist or contains nothing.
+-- Ignores "lost+found" which can exist in an empty filesystem.
+isUnpopulated :: FilePath -> IO Bool
+isUnpopulated d = catchDefaultIO True $ testDirectory d fsCruft
+
+fsCruft :: FilePath -> Bool
+fsCruft "lost+found" = True
+fsCruft d = dirCruft d
+
+-- | Run test on entries found in directory, return False as soon as the
+-- test returns False, else return True.  Throws exception if directory does
+-- not exist.
+testDirectory :: FilePath -> (FilePath -> Bool) -> IO Bool
+testDirectory d test = bracket (openDirectory d) closeDirectory check
+  where
+	check h = do
+		v <- readDirectory h
+		case v of
+			Nothing -> return True
+			Just f
+				| not (test f) -> return False
+				| otherwise -> check h
diff --git a/src/Utility/Env.hs b/src/Utility/Env.hs
--- a/src/Utility/Env.hs
+++ b/src/Utility/Env.hs
@@ -16,7 +16,6 @@
 import Data.Maybe
 import Prelude
 import qualified System.Environment as E
-import qualified System.SetEnv
 #else
 import qualified System.Posix.Env as PE
 #endif
@@ -40,29 +39,6 @@
 getEnvironment = PE.getEnvironment
 #else
 getEnvironment = E.getEnvironment
-#endif
-
-{- Sets an environment variable. To overwrite an existing variable,
- - overwrite must be True.
- -
- - On Windows, setting a variable to "" unsets it. -}
-setEnv :: String -> String -> Bool -> IO ()
-#ifndef mingw32_HOST_OS
-setEnv var val overwrite = PE.setEnv var val overwrite
-#else
-setEnv var val True = System.SetEnv.setEnv var val
-setEnv var val False = do
-	r <- getEnv var
-	case r of
-		Nothing -> setEnv var val True
-		Just _ -> return ()
-#endif
-
-unsetEnv :: String -> IO ()
-#ifndef mingw32_HOST_OS
-unsetEnv = PE.unsetEnv
-#else
-unsetEnv = System.SetEnv.unsetEnv
 #endif
 
 {- Adds the environment variable to the input environment. If already
diff --git a/src/Utility/Env/Basic.hs b/src/Utility/Env/Basic.hs
new file mode 100644
--- /dev/null
+++ b/src/Utility/Env/Basic.hs
@@ -0,0 +1,22 @@
+{- portable environment variables, without any dependencies
+ -
+ - Copyright 2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Env.Basic where
+
+import Utility.Exception
+import Control.Applicative
+import Data.Maybe
+import Prelude
+import qualified System.Environment as E
+
+getEnv :: String -> IO (Maybe String)
+getEnv = catchMaybeIO . E.getEnv
+
+getEnvDefault :: String -> String -> IO String
+getEnvDefault var fallback = fromMaybe fallback <$> getEnv var
diff --git a/src/Utility/Env/Set.hs b/src/Utility/Env/Set.hs
new file mode 100644
--- /dev/null
+++ b/src/Utility/Env/Set.hs
@@ -0,0 +1,41 @@
+{- portable environment variables
+ -
+ - Copyright 2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.Env.Set where
+
+#ifdef mingw32_HOST_OS
+import qualified System.Environment as E
+import qualified System.SetEnv
+import Utility.Env
+#else
+import qualified System.Posix.Env as PE
+#endif
+
+{- Sets an environment variable. To overwrite an existing variable,
+ - overwrite must be True.
+ -
+ - On Windows, setting a variable to "" unsets it. -}
+setEnv :: String -> String -> Bool -> IO ()
+#ifndef mingw32_HOST_OS
+setEnv var val overwrite = PE.setEnv var val overwrite
+#else
+setEnv var val True = System.SetEnv.setEnv var val
+setEnv var val False = do
+	r <- getEnv var
+	case r of
+		Nothing -> setEnv var val True
+		Just _ -> return ()
+#endif
+
+unsetEnv :: String -> IO ()
+#ifndef mingw32_HOST_OS
+unsetEnv = PE.unsetEnv
+#else
+unsetEnv = System.SetEnv.unsetEnv
+#endif
diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs
--- a/src/Utility/Exception.hs
+++ b/src/Utility/Exception.hs
@@ -5,7 +5,7 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Exception (
@@ -29,11 +29,7 @@
 import Control.Monad.Catch as X hiding (Handler)
 import qualified Control.Monad.Catch as M
 import Control.Exception (IOException, AsyncException)
-#ifdef MIN_VERSION_GLASGOW_HASKELL
-#if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0)
 import Control.Exception (SomeAsyncException)
-#endif
-#endif
 import Control.Monad
 import Control.Monad.IO.Class (liftIO, MonadIO)
 import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
@@ -46,15 +42,7 @@
  - where there's a problem that the user is excpected to see in some
  - circumstances. -}
 giveup :: [Char] -> a
-#ifdef MIN_VERSION_base
-#if MIN_VERSION_base(4,9,0)
 giveup = errorWithoutStackTrace
-#else
-giveup = error
-#endif
-#else
-giveup = error
-#endif
 
 {- Catches IO errors and returns a Bool -}
 catchBoolIO :: MonadCatch m => m Bool -> m Bool
@@ -95,11 +83,7 @@
 catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a
 catchNonAsync a onerr = a `catches`
 	[ M.Handler (\ (e :: AsyncException) -> throwM e)
-#ifdef MIN_VERSION_GLASGOW_HASKELL
-#if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0)
 	, M.Handler (\ (e :: SomeAsyncException) -> throwM e)
-#endif
-#endif
 	, M.Handler (\ (e :: SomeException) -> onerr e)
 	]
 
diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs
--- a/src/Utility/FileMode.hs
+++ b/src/Utility/FileMode.hs
@@ -15,9 +15,9 @@
 import System.IO
 import Control.Monad
 import System.PosixCompat.Types
-import Utility.PosixFiles
+import System.PosixCompat.Files
 #ifndef mingw32_HOST_OS
-import System.Posix.Files
+import System.Posix.Files (symbolicLinkMode)
 import Control.Monad.IO.Class (liftIO)
 #endif
 import Control.Monad.IO.Class (MonadIO)
@@ -69,6 +69,7 @@
 otherGroupModes = 
 	[ groupReadMode, otherReadMode
 	, groupWriteMode, otherWriteMode
+	, groupExecuteMode, otherExecuteMode
 	]
 
 {- Removes the write bits from a file. -}
diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs
--- a/src/Utility/FileSystemEncoding.hs
+++ b/src/Utility/FileSystemEncoding.hs
@@ -12,6 +12,9 @@
 	useFileSystemEncoding,
 	fileEncoding,
 	withFilePath,
+	RawFilePath,
+	fromRawFilePath,
+	toRawFilePath,
 	decodeBS,
 	encodeBS,
 	decodeW8,
@@ -32,6 +35,7 @@
 import System.IO.Unsafe
 import Data.Word
 import Data.List
+import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 #ifdef mingw32_HOST_OS
 import qualified Data.ByteString.Lazy.UTF8 as L8
@@ -119,6 +123,22 @@
 #else
 encodeBS = L8.fromString
 #endif
+
+{- Recent versions of the unix package have this alias; defined here
+ - for backwards compatibility. -}
+type RawFilePath = S.ByteString
+
+{- Note that the RawFilePath is assumed to never contain NUL,
+ - since filename's don't. This should only be used with actual
+ - RawFilePaths not arbitrary ByteString that may contain NUL. -}
+fromRawFilePath :: RawFilePath -> FilePath
+fromRawFilePath = encodeW8 . S.unpack
+
+{- Note that the FilePath is assumed to never contain NUL,
+ - since filename's don't. This should only be used with actual FilePaths
+ - not arbitrary String that may contain NUL. -}
+toRawFilePath :: FilePath -> RawFilePath
+toRawFilePath = S.pack . decodeW8
 
 {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
  -
diff --git a/src/Utility/Misc.hs b/src/Utility/Misc.hs
--- a/src/Utility/Misc.hs
+++ b/src/Utility/Misc.hs
@@ -5,7 +5,6 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Misc where
@@ -16,10 +15,6 @@
 import Data.Char
 import Data.List
 import System.Exit
-#ifndef mingw32_HOST_OS
-import System.Posix.Process (getAnyProcessStatus)
-import Utility.Exception
-#endif
 import Control.Applicative
 import Prelude
 
@@ -111,22 +106,6 @@
   where
 	peekbytes :: Int -> Ptr Word8 -> IO [Word8]
 	peekbytes len buf = mapM (peekElemOff buf) [0..pred len]
-
-{- Reaps any zombie git processes. 
- -
- - Warning: Not thread safe. Anything that was expecting to wait
- - on a process and get back an exit status is going to be confused
- - if this reap gets there first. -}
-reapZombies :: IO ()
-#ifndef mingw32_HOST_OS
-reapZombies =
-	-- throws an exception when there are no child processes
-	catchDefaultIO Nothing (getAnyProcessStatus False True)
-		>>= maybe (return ()) (const reapZombies)
-
-#else
-reapZombies = return ()
-#endif
 
 exitBool :: Bool -> IO a
 exitBool False = exitFailure
diff --git a/src/Utility/PartialPrelude.hs b/src/Utility/PartialPrelude.hs
--- a/src/Utility/PartialPrelude.hs
+++ b/src/Utility/PartialPrelude.hs
@@ -38,11 +38,9 @@
 
 {- Attempts to read a value from a String.
  -
- - Ignores leading/trailing whitespace, and throws away any trailing
- - text after the part that can be read.
- -
- - readMaybe is available in Text.Read in new versions of GHC,
- - but that one requires the entire string to be consumed.
+ - Unlike Text.Read.readMaybe, this ignores some trailing text
+ - after the part that can be read. However, if the trailing text looks
+ - like another readable value, it fails.
  -}
 readish :: Read a => String -> Maybe a
 readish s = case reads s of
diff --git a/src/Utility/Path.hs b/src/Utility/Path.hs
--- a/src/Utility/Path.hs
+++ b/src/Utility/Path.hs
@@ -5,7 +5,7 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE PackageImports, CPP #-}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Path where
@@ -17,13 +17,6 @@
 import Control.Applicative
 import Prelude
 
-#ifdef mingw32_HOST_OS
-import qualified System.FilePath.Posix as Posix
-#else
-import System.Posix.Files
-import Utility.Exception
-#endif
-
 import Utility.Monad
 import Utility.UserInfo
 import Utility.Directory
@@ -136,17 +129,22 @@
  -}
 relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
 relPathDirToFileAbs from to
-	| takeDrive from /= takeDrive to = to
+#ifdef mingw32_HOST_OS
+	| normdrive from /= normdrive to = to
+#endif
 	| otherwise = joinPath $ dotdots ++ uncommon
   where
 	pfrom = sp from
 	pto = sp to
-	sp = map dropTrailingPathSeparator . splitPath
+	sp = map dropTrailingPathSeparator . splitPath . dropDrive
 	common = map fst $ takeWhile same $ zip pfrom pto
 	same (c,d) = c == d
 	uncommon = drop numcommon pto
 	dotdots = replicate (length pfrom - numcommon) ".."
 	numcommon = length common
+#ifdef mingw32_HOST_OS
+	normdrive = map toLower . takeWhile (/= ':') . takeDrive
+#endif
 
 prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
 prop_relPathDirToFile_basics from to
@@ -241,50 +239,6 @@
 	| otherwise = "." `isPrefixOf` f || dotfile (takeDirectory file)
   where
 	f = takeFileName file
-
-{- Converts a DOS style path to a msys2 style path. Only on Windows.
- - Any trailing '\' is preserved as a trailing '/' 
- - 
- - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i
- -
- - The virtual filesystem contains:
- -  /c, /d, ...	mount points for Windows drives
- -}
-toMSYS2Path :: FilePath -> FilePath
-#ifndef mingw32_HOST_OS
-toMSYS2Path = id
-#else
-toMSYS2Path p
-	| null drive = recombine parts
-	| otherwise = recombine $ "/" : driveletter drive : parts
-  where
-	(drive, p') = splitDrive p
-	parts = splitDirectories p'
-	driveletter = map toLower . takeWhile (/= ':')
-	recombine = fixtrailing . Posix.joinPath
-	fixtrailing s
-		| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s
-		| otherwise = s
-#endif
-
-{- Maximum size to use for a file in a specified directory.
- -
- - Many systems have a 255 byte limit to the name of a file, 
- - so that's taken as the max if the system has a larger limit, or has no
- - limit.
- -}
-fileNameLengthLimit :: FilePath -> IO Int
-#ifdef mingw32_HOST_OS
-fileNameLengthLimit _ = return 255
-#else
-fileNameLengthLimit dir = do
-	-- getPathVar can fail due to statfs(2) overflow
-	l <- catchDefaultIO 0 $
-		fromIntegral <$> getPathVar dir FileNameLimit
-	if l <= 0
-		then return 255
-		else return $ minimum [l, 255]
-#endif
 
 {- Given a string that we'd like to use as the basis for FilePath, but that
  - was provided by a third party and is not to be trusted, returns the closest
diff --git a/src/Utility/PosixFiles.hs b/src/Utility/PosixFiles.hs
deleted file mode 100644
--- a/src/Utility/PosixFiles.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-{- POSIX files (and compatablity wrappers).
- -
- - This is like System.PosixCompat.Files, but with a few fixes.
- -
- - Copyright 2014 Joey Hess <id@joeyh.name>
- -
- - License: BSD-2-clause
- -}
-
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-tabs #-}
-
-module Utility.PosixFiles (
-	module X,
-	rename
-) where
-
-import System.PosixCompat.Files as X hiding (rename)
-
-#ifndef mingw32_HOST_OS
-import System.Posix.Files (rename)
-#else
-import qualified System.Win32.File as Win32
-import qualified System.Win32.HardLink as Win32
-#endif
-
-{- System.PosixCompat.Files.rename on Windows calls renameFile,
- - so cannot rename directories. 
- -
- - Instead, use Win32 moveFile, which can. It needs to be told to overwrite
- - any existing file. -}
-#ifdef mingw32_HOST_OS
-rename :: FilePath -> FilePath -> IO ()
-rename src dest = Win32.moveFileEx src dest Win32.mOVEFILE_REPLACE_EXISTING
-#endif
-
-{- System.PosixCompat.Files.createLink throws an error, but windows
- - does support hard links. -}
-#ifdef mingw32_HOST_OS
-createLink :: FilePath -> FilePath -> IO ()
-createLink = Win32.createHardLink
-#endif
diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -24,11 +24,10 @@
 	createProcessSuccess,
 	createProcessChecked,
 	createBackgroundProcess,
-	processTranscript,
-	processTranscript',
 	withHandle,
 	withIOHandles,
 	withOEHandles,
+	withNullHandle,
 	withQuietOutput,
 	feedWithQuietOutput,
 	createProcess,
@@ -54,13 +53,6 @@
 import Control.Concurrent
 import qualified Control.Exception as E
 import Control.Monad
-#ifndef mingw32_HOST_OS
-import qualified System.Posix.IO
-#else
-import Control.Applicative
-#endif
-import Data.Maybe
-import Prelude
 
 type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a
 
@@ -170,68 +162,6 @@
 createBackgroundProcess :: CreateProcessRunner
 createBackgroundProcess p a = a =<< createProcess p
 
--- | Runs a process, optionally feeding it some input, and
--- returns a transcript combining its stdout and stderr, and
--- whether it succeeded or failed.
-processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
-processTranscript cmd opts = processTranscript' (proc cmd opts)
-
-processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
-processTranscript' cp input = do
-#ifndef mingw32_HOST_OS
-{- This implementation interleves stdout and stderr in exactly the order
- - the process writes them. -}
-	(readf, writef) <- System.Posix.IO.createPipe
-	readh <- System.Posix.IO.fdToHandle readf
-	writeh <- System.Posix.IO.fdToHandle writef
-	p@(_, _, _, pid) <- createProcess $ cp
-		{ std_in = if isJust input then CreatePipe else Inherit
-		, std_out = UseHandle writeh
-		, std_err = UseHandle writeh
-		}
-	hClose writeh
-
-	get <- mkreader readh
-	writeinput input p
-	transcript <- get
-
-	ok <- checkSuccessProcess pid
-	return (transcript, ok)
-#else
-{- This implementation for Windows puts stderr after stdout. -}
-	p@(_, _, _, pid) <- createProcess $ cp
-		{ std_in = if isJust input then CreatePipe else Inherit
-		, std_out = CreatePipe
-		, std_err = CreatePipe
-		}
-
-	getout <- mkreader (stdoutHandle p)
-	geterr <- mkreader (stderrHandle p)
-	writeinput input p
-	transcript <- (++) <$> getout <*> geterr
-
-	ok <- checkSuccessProcess pid
-	return (transcript, ok)
-#endif
-  where
-	mkreader h = do
-		s <- hGetContents h
-		v <- newEmptyMVar
-		void $ forkIO $ do
-			void $ E.evaluate (length s)
-			putMVar v ()
-		return $ do
-			takeMVar v
-			return s
-
-	writeinput (Just s) p = do
-		let inh = stdinHandle p
-		unless (null s) $ do
-			hPutStr inh s
-			hFlush inh
-		hClose inh
-	writeinput Nothing _ = return ()
-
 -- | Runs a CreateProcessRunner, on a CreateProcess structure, that
 -- is adjusted to pipe only from/to a single StdHandle, and passes
 -- the resulting Handle to an action.
@@ -248,13 +178,10 @@
 		, std_out = Inherit
 		, std_err = Inherit
 		}
-	(select, p')
-		| h == StdinHandle  =
-			(stdinHandle, base { std_in = CreatePipe })
-		| h == StdoutHandle =
-			(stdoutHandle, base { std_out = CreatePipe })
-		| h == StderrHandle =
-			(stderrHandle, base { std_err = CreatePipe })
+	(select, p') = case h of
+		StdinHandle -> (stdinHandle, base { std_in = CreatePipe })
+		StdoutHandle -> (stdoutHandle, base { std_out = CreatePipe })
+		StderrHandle -> (stderrHandle, base { std_err = CreatePipe })
 
 -- | Like withHandle, but passes (stdin, stdout) handles to the action.
 withIOHandles
@@ -284,13 +211,16 @@
 		, std_err = CreatePipe
 		}
 
+withNullHandle :: (Handle -> IO a) -> IO a
+withNullHandle = withFile devNull WriteMode
+
 -- | Forces the CreateProcessRunner to run quietly;
 -- both stdout and stderr are discarded.
 withQuietOutput
 	:: CreateProcessRunner
 	-> CreateProcess
 	-> IO ()
-withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do
+withQuietOutput creator p = withNullHandle $ \nullh -> do
 	let p' = p
 		{ std_out = UseHandle nullh
 		, std_err = UseHandle nullh
@@ -316,7 +246,8 @@
 #ifndef mingw32_HOST_OS
 devNull = "/dev/null"
 #else
-devNull = "NUL"
+-- Use device namespace to prevent GHC from rewriting path
+devNull = "\\\\.\\NUL"
 #endif
 
 -- | Extract a desired handle from createProcess's tuple.
diff --git a/src/Utility/Process/Shim.hs b/src/Utility/Process/Shim.hs
--- a/src/Utility/Process/Shim.hs
+++ b/src/Utility/Process/Shim.hs
@@ -1,4 +1,3 @@
-module Utility.Process.Shim (module X, createProcess, waitForProcess) where
+module Utility.Process.Shim (module X) where
 
-import System.Process as X hiding (createProcess, waitForProcess)
-import System.Process.Concurrent
+import System.Process as X
diff --git a/src/Utility/Process/Transcript.hs b/src/Utility/Process/Transcript.hs
new file mode 100644
--- /dev/null
+++ b/src/Utility/Process/Transcript.hs
@@ -0,0 +1,83 @@
+{- Process transcript
+ -
+ - Copyright 2012-2018 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Process.Transcript where
+
+import Utility.Process
+import Utility.Misc
+
+import System.IO
+import System.Exit
+import Control.Concurrent.Async
+import Control.Monad
+#ifndef mingw32_HOST_OS
+import qualified System.Posix.IO
+#else
+import Control.Applicative
+#endif
+import Data.Maybe
+import Prelude
+
+-- | Runs a process and returns a transcript combining its stdout and
+-- stderr, and whether it succeeded or failed.
+processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
+processTranscript cmd opts = processTranscript' (proc cmd opts)
+
+-- | Also feeds the process some input.
+processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
+processTranscript' cp input = do
+	(t, c) <- processTranscript'' cp input
+	return (t, c == ExitSuccess)
+
+processTranscript'' :: CreateProcess -> Maybe String -> IO (String, ExitCode)
+processTranscript'' cp input = do
+#ifndef mingw32_HOST_OS
+{- This implementation interleves stdout and stderr in exactly the order
+ - the process writes them. -}
+	(readf, writef) <- System.Posix.IO.createPipe
+	System.Posix.IO.setFdOption readf System.Posix.IO.CloseOnExec True
+	System.Posix.IO.setFdOption writef System.Posix.IO.CloseOnExec True
+	readh <- System.Posix.IO.fdToHandle readf
+	writeh <- System.Posix.IO.fdToHandle writef
+	p@(_, _, _, pid) <- createProcess $ cp
+		{ std_in = if isJust input then CreatePipe else Inherit
+		, std_out = UseHandle writeh
+		, std_err = UseHandle writeh
+		}
+	hClose writeh
+
+	get <- asyncreader readh
+	writeinput input p
+	transcript <- wait get
+#else
+{- This implementation for Windows puts stderr after stdout. -}
+	p@(_, _, _, pid) <- createProcess $ cp
+		{ std_in = if isJust input then CreatePipe else Inherit
+		, std_out = CreatePipe
+		, std_err = CreatePipe
+		}
+
+	getout <- asyncreader (stdoutHandle p)
+	geterr <- asyncreader (stderrHandle p)
+	writeinput input p
+	transcript <- (++) <$> wait getout <*> wait geterr
+#endif
+	code <- waitForProcess pid
+	return (transcript, code)
+  where
+	asyncreader = async . hGetContentsStrict
+
+	writeinput (Just s) p = do
+		let inh = stdinHandle p
+		unless (null s) $ do
+			hPutStr inh s
+			hFlush inh
+		hClose inh
+	writeinput Nothing _ = return ()
diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs
--- a/src/Utility/SafeCommand.hs
+++ b/src/Utility/SafeCommand.hs
@@ -27,19 +27,21 @@
 -- | Used to pass a list of CommandParams to a function that runs
 -- a command and expects Strings. -}
 toCommand :: [CommandParam] -> [String]
-toCommand = map unwrap
+toCommand = map toCommand'
+
+toCommand' :: CommandParam -> String
+toCommand' (Param s) = s
+-- Files that start with a non-alphanumeric that is not a path
+-- separator are modified to avoid the command interpreting them as
+-- options or other special constructs.
+toCommand' (File s@(h:_))
+	| isAlphaNum h || h `elem` pathseps = s
+	| otherwise = "./" ++ s
   where
-	unwrap (Param s) = s
-	-- Files that start with a non-alphanumeric that is not a path
-	-- separator are modified to avoid the command interpreting them as
-	-- options or other special constructs.
-	unwrap (File s@(h:_))
-		| isAlphaNum h || h `elem` pathseps = s
-		| otherwise = "./" ++ s
-	unwrap (File s) = s
 	-- '/' is explicitly included because it's an alternative
 	-- path separator on Windows.
 	pathseps = pathSeparator:"./"
+toCommand' (File s) = s
 
 -- | Run a system command, and returns True or False if it succeeded or failed.
 --
diff --git a/src/Utility/Scheduled.hs b/src/Utility/Scheduled.hs
--- a/src/Utility/Scheduled.hs
+++ b/src/Utility/Scheduled.hs
@@ -30,6 +30,7 @@
 import Utility.PartialPrelude
 import Utility.Misc
 import Utility.Tuple
+import Utility.Split
 
 import Data.List
 import Data.Time.Clock
@@ -265,7 +266,7 @@
 	constructor "month" = Just Monthly
 	constructor "year" = Just Yearly
 	constructor u
-		| "s" `isSuffixOf` u = constructor $ reverse $ drop 1 $ reverse u
+		| "s" `isSuffixOf` u = constructor $ dropFromEnd 1 u
 		| otherwise = Nothing
 	withday sd u = do
 		c <- constructor u
diff --git a/src/Utility/Split.hs b/src/Utility/Split.hs
--- a/src/Utility/Split.hs
+++ b/src/Utility/Split.hs
@@ -28,3 +28,7 @@
 -- | same as Data.List.Utils.replace
 replace :: Eq a => [a] -> [a] -> [a] -> [a] 
 replace old new = intercalate new . split old
+
+-- | Only traverses the list once while dropping the last n characters.
+dropFromEnd :: Int -> [a] -> [a]
+dropFromEnd n l = zipWith const l (drop n l)
diff --git a/src/Utility/ThreadScheduler.hs b/src/Utility/ThreadScheduler.hs
--- a/src/Utility/ThreadScheduler.hs
+++ b/src/Utility/ThreadScheduler.hs
@@ -18,10 +18,8 @@
 #endif
 #ifndef mingw32_HOST_OS
 import System.Posix.Signals
-#ifndef __ANDROID__
 import System.Posix.Terminal
 #endif
-#endif
 
 newtype Seconds = Seconds { fromSeconds :: Int }
 	deriving (Eq, Ord, Show)
@@ -63,10 +61,8 @@
 	let check sig = void $
 		installHandler sig (CatchOnce $ putMVar lock ()) Nothing
 	check softwareTermination
-#ifndef __ANDROID__
 	whenM (queryTerminal stdInput) $
 		check keyboardSignal
-#endif
 	takeMVar lock
 #endif
 
diff --git a/src/Utility/Tmp.hs b/src/Utility/Tmp.hs
--- a/src/Utility/Tmp.hs
+++ b/src/Utility/Tmp.hs
@@ -1,4 +1,4 @@
-{- Temporary files and directories.
+{- Temporary files.
  -
  - Copyright 2010-2013 Joey Hess <id@joeyh.name>
  -
@@ -11,24 +11,20 @@
 module Utility.Tmp where
 
 import System.IO
-import Control.Monad.IfElse
 import System.FilePath
 import System.Directory
 import Control.Monad.IO.Class
-#ifndef mingw32_HOST_OS
-import System.Posix.Temp (mkdtemp)
-#endif
+import System.PosixCompat.Files
 
 import Utility.Exception
 import Utility.FileSystemEncoding
-import Utility.PosixFiles
 
 type Template = String
 
 {- Runs an action like writeFile, writing to a temp file first and
  - then moving it into place. The temp file is stored in the same
  - directory as the final file to avoid cross-device renames. -}
-viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> String -> m ()) -> FilePath -> String -> m ()
+viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m ()
 viaTmp a file content = bracketIO setup cleanup use
   where
 	(dir, base) = splitFileName file
@@ -61,51 +57,6 @@
 		hClose h
 		catchBoolIO (removeFile name >> return True)
 	use (name, h) = a name h
-
-{- Runs an action with a tmp directory located within the system's tmp
- - directory (or within "." if there is none), then removes the tmp
- - directory and all its contents. -}
-withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
-withTmpDir template a = do
-	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
-#ifndef mingw32_HOST_OS
-	-- Use mkdtemp to create a temp directory securely in /tmp.
-	bracket
-		(liftIO $ mkdtemp $ topleveltmpdir </> template)
-		removeTmpDir
-		a
-#else
-	withTmpDirIn topleveltmpdir template a
-#endif
-
-{- Runs an action with a tmp directory located within a specified directory,
- - then removes the tmp directory and all its contents. -}
-withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
-withTmpDirIn tmpdir template = bracketIO create removeTmpDir
-  where
-	create = do
-		createDirectoryIfMissing True tmpdir
-		makenewdir (tmpdir </> template) (0 :: Int)
-	makenewdir t n = do
-		let dir = t ++ "." ++ show n
-		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
-			createDirectory dir
-			return dir
-
-{- Deletes the entire contents of the the temporary directory, if it
- - exists. -}
-removeTmpDir :: MonadIO m => FilePath -> m ()
-removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
-#if mingw32_HOST_OS
-	-- Windows will often refuse to delete a file
-	-- after a process has just written to it and exited.
-	-- Because it's crap, presumably. So, ignore failure
-	-- to delete the temp directory.
-	_ <- tryIO $ removeDirectoryRecursive tmpdir
-	return ()
-#else
-	removeDirectoryRecursive tmpdir
-#endif
 
 {- It's not safe to use a FilePath of an existing file as the template
  - for openTempFile, because if the FilePath is really long, the tmpfile
diff --git a/src/Utility/Tmp/Dir.hs b/src/Utility/Tmp/Dir.hs
new file mode 100644
--- /dev/null
+++ b/src/Utility/Tmp/Dir.hs
@@ -0,0 +1,67 @@
+{- Temporary directories
+ -
+ - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Tmp.Dir where
+
+import Control.Monad.IfElse
+import System.FilePath
+import System.Directory
+import Control.Monad.IO.Class
+#ifndef mingw32_HOST_OS
+import System.Posix.Temp (mkdtemp)
+#endif
+
+import Utility.Exception
+import Utility.Tmp (Template)
+
+{- Runs an action with a tmp directory located within the system's tmp
+ - directory (or within "." if there is none), then removes the tmp
+ - directory and all its contents. -}
+withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
+withTmpDir template a = do
+	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
+#ifndef mingw32_HOST_OS
+	-- Use mkdtemp to create a temp directory securely in /tmp.
+	bracket
+		(liftIO $ mkdtemp $ topleveltmpdir </> template)
+		removeTmpDir
+		a
+#else
+	withTmpDirIn topleveltmpdir template a
+#endif
+
+{- Runs an action with a tmp directory located within a specified directory,
+ - then removes the tmp directory and all its contents. -}
+withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
+withTmpDirIn tmpdir template = bracketIO create removeTmpDir
+  where
+	create = do
+		createDirectoryIfMissing True tmpdir
+		makenewdir (tmpdir </> template) (0 :: Int)
+	makenewdir t n = do
+		let dir = t ++ "." ++ show n
+		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
+			createDirectory dir
+			return dir
+
+{- Deletes the entire contents of the the temporary directory, if it
+ - exists. -}
+removeTmpDir :: MonadIO m => FilePath -> m ()
+removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
+#if mingw32_HOST_OS
+	-- Windows will often refuse to delete a file
+	-- after a process has just written to it and exited.
+	-- Because it's crap, presumably. So, ignore failure
+	-- to delete the temp directory.
+	_ <- tryIO $ removeDirectoryRecursive tmpdir
+	return ()
+#else
+	removeDirectoryRecursive tmpdir
+#endif
diff --git a/src/Utility/UserInfo.hs b/src/Utility/UserInfo.hs
--- a/src/Utility/UserInfo.hs
+++ b/src/Utility/UserInfo.hs
@@ -14,12 +14,14 @@
 	myUserGecos,
 ) where
 
-import Utility.Env
-import Utility.Data
+import Utility.Env.Basic
 import Utility.Exception
+#ifndef mingw32_HOST_OS
+import Utility.Data
+import Control.Applicative
+#endif
 
 import System.PosixCompat
-import Control.Applicative
 import Prelude
 
 {- Current user's home directory.
@@ -45,8 +47,8 @@
 #endif
 
 myUserGecos :: IO (Maybe String)
--- userGecos crashes on Android and is not available on Windows.
-#if defined(__ANDROID__) || defined(mingw32_HOST_OS)
+-- userGecos is not available on Windows.
+#if defined(mingw32_HOST_OS)
 myUserGecos = return Nothing
 #else
 myUserGecos = eitherToMaybe <$> myVal [] userGecos
@@ -55,9 +57,13 @@
 myVal :: [String] -> (UserEntry -> String) -> IO (Either String String)
 myVal envvars extract = go envvars
   where
+	go [] = either (const $ envnotset) (Right . extract) <$> get
+	go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
 #ifndef mingw32_HOST_OS
-	go [] = Right . extract <$> (getUserEntryForID =<< getEffectiveUserID)
+	-- This may throw an exception if the system doesn't have a
+	-- passwd file etc; don't let it crash.
+	get = tryNonAsync $ getUserEntryForID =<< getEffectiveUserID
 #else
-	go [] = return $ Left ("environment not set: " ++ show envvars)
+	get = return envnotset
 #endif
-	go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
+	envnotset = Left ("environment not set: " ++ show envvars)