propellor 3.0.1 → 3.0.2

raw patch · 21 files changed

+356/−126 lines, 21 files

Files

• CHANGELOG +13/−0
• debian/changelog +13/−0
• propellor.cabal +5/−3
• src/Propellor/Debug.hs +1/−1
• src/Propellor/DotDir.hs +1/−1
• src/Propellor/Engine.hs +1/−1
• src/Propellor/Git.hs +1/−1
• src/Propellor/Gpg.hs +1/−1
• src/Propellor/PrivData.hs +1/−1
• src/Propellor/Property.hs +1/−1
• src/Propellor/Property/Apt.hs +29/−12
• src/Propellor/Property/Attic.hs +147/−0
• src/Propellor/Property/Chroot/Util.hs +0/−1
• src/Propellor/Property/DiskImage.hs +1/−0
• src/Propellor/Property/Fstab.hs +111/−0
• src/Propellor/Property/Mount.hs +7/−77
• src/System/Console/Concurrent/Internal.hs +0/−13
• src/Utility/Directory.hs +8/−3
• src/Utility/LinuxMkLibs.hs +0/−1
• src/Utility/Path.hs +14/−8
• src/wrapper.hs +1/−1

@@ -1,3 +1,16 @@+propellor (3.0.2) unstable; urgency=medium++  * Added Apt.periodicUpdates.+    Thanks, Félix Sipma.+  * Apt.unattendedUpgrades: Enable mailing problem reports to root.+    Thanks, Félix Sipma.+  * Added Propellor.Property.Fstab, and moved the fstabbed property to there.+  * Attic module added for the backup system.+    Thanks, Félix Sipma.+  * Fix build with directory-1.2.6.2.++ -- Joey Hess <id@joeyh.name>  Sat, 30 Apr 2016 15:46:50 -0400+ propellor (3.0.1) unstable; urgency=medium    * propellor --init now runs cabal sandbox init if cabal has been

@@ -1,3 +1,16 @@+propellor (3.0.2) unstable; urgency=medium++  * Added Apt.periodicUpdates.+    Thanks, Félix Sipma.+  * Apt.unattendedUpgrades: Enable mailing problem reports to root.+    Thanks, Félix Sipma.+  * Added Propellor.Property.Fstab, and moved the fstabbed property to there.+  * Attic module added for the backup system.+    Thanks, Félix Sipma.+  * Fix build with directory-1.2.6.2.++ -- Joey Hess <id@joeyh.name>  Sat, 30 Apr 2016 15:46:50 -0400+ propellor (3.0.1) unstable; urgency=medium    * propellor --init now runs cabal sandbox init if cabal has been

@@ -1,5 +1,5 @@ Name: propellor-Version: 3.0.1+Version: 3.0.2 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -53,7 +53,7 @@   GHC-Options: -threaded -Wall -fno-warn-tabs -O0   Extensions: TypeOperators   Hs-Source-Dirs: src-  Build-Depends: +  Build-Depends:     base >= 4.5, base < 5,     MissingH, directory, filepath, IfElse, process, bytestring, hslogger,     unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,@@ -63,7 +63,7 @@   GHC-Options: -Wall -fno-warn-tabs -O0   Extensions: TypeOperators   Hs-Source-Dirs: src-  Build-Depends: +  Build-Depends:     base >= 4.5, base < 5,     MissingH, directory, filepath, IfElse, process, bytestring, hslogger,     unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,@@ -78,6 +78,7 @@     Propellor.Property.Apache     Propellor.Property.Apt     Propellor.Property.Apt.PPA+    Propellor.Property.Attic     Propellor.Property.Cmd     Propellor.Property.Concurrent     Propellor.Property.Conductor@@ -98,6 +99,7 @@     Propellor.Property.FreeBSD     Propellor.Property.FreeBSD.Pkg     Propellor.Property.FreeBSD.Poudriere+    Propellor.Property.Fstab     Propellor.Property.Git     Propellor.Property.Gpg     Propellor.Property.Group

@@ -2,7 +2,6 @@  import Control.Monad.IfElse import System.IO-import System.Directory import System.Log.Logger import System.Log.Formatter import System.Log.Handler (setFormatter)@@ -14,6 +13,7 @@ import Utility.Env import Utility.Exception import Utility.Process+import Utility.Directory  debug :: [String] -> IO () debug = debugM "propellor" . unwords

@@ -15,6 +15,7 @@ import Utility.Process import Utility.SafeCommand import Utility.Exception+import Utility.Directory import Utility.Path -- This module is autogenerated by the build system. import qualified Paths_propellor as Package@@ -24,7 +25,6 @@ import Data.Version import Control.Monad import Control.Monad.IfElse-import System.Directory import System.FilePath import System.Posix.Directory import System.IO

@@ -17,7 +17,6 @@ import System.PosixCompat import System.Posix.IO import System.FilePath-import System.Directory import Control.Applicative import Prelude @@ -28,6 +27,7 @@ import Propellor.Exception import Propellor.Info import Utility.Exception+import Utility.Directory  -- | Gets the Properties of a Host, and ensures them all, -- with nice display of what's being done.

@@ -2,8 +2,8 @@  import Utility.Process import Utility.Exception+import Utility.Directory -import System.Directory import Control.Applicative import Prelude 

@@ -1,7 +1,6 @@ module Propellor.Gpg where  import System.IO-import System.Directory import Data.Maybe import Data.List.Utils import Control.Monad@@ -19,6 +18,7 @@ import Utility.Tmp import Utility.FileSystemEncoding import Utility.Env+import Utility.Directory  type KeyId = String 

@@ -26,7 +26,6 @@ ) where  import System.IO-import System.Directory import Data.Maybe import Data.List import Data.Typeable@@ -59,6 +58,7 @@ import Utility.Env import Utility.Table import Utility.FileSystemEncoding+import Utility.Directory  -- | Allows a Property to access the value of a specific PrivDataField, -- for use in a specific Context or HostContext.

@@ -44,7 +44,6 @@ 	, assume ) where -import System.Directory import System.FilePath import Control.Monad import Data.Monoid@@ -66,6 +65,7 @@ import Utility.Exception import Utility.Monad import Utility.Misc+import Utility.Directory  -- | Makes a perhaps non-idempotent Property be idempotent by using a flag -- file to indicate whether it has run before.

@@ -117,6 +117,7 @@ 		, ("APT_LISTCHANGES_FRONTEND", "none") 		] +-- | Have apt update its lists of packages, but without upgrading anything. update :: Property DebianLike update = combineProperties ("apt update") $ props 	& pendingConfigured@@ -124,7 +125,7 @@ 		`assume` MadeChange  -- | Have apt upgrade packages, adding new packages and removing old as--- necessary.+-- necessary. Often used in combination with the `update` property. upgrade :: Property DebianLike upgrade = upgrade' "dist-upgrade" @@ -248,16 +249,32 @@ 			| otherwise = "false"  	configure :: Property DebianLike-	configure = withOS "unattended upgrades configured" $ \w o ->-		case o of-			-- the package defaults to only upgrading stable-			(Just (System (Debian suite) _))-				| not (isStable suite) -> ensureProperty w $-					"/etc/apt/apt.conf.d/50unattended-upgrades"-						`File.containsLine`-					("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")-			_ -> noChange+	configure = propertyList "unattended upgrades configured" $ props+		& enableupgrading+		& unattendedconfig `File.containsLine` "Unattended-Upgrade::Mail \"root\";"+	  where+		enableupgrading :: Property DebianLike+		enableupgrading = withOS "unattended upgrades configured" $ \w o ->+			case o of+				-- the package defaults to only upgrading stable+				(Just (System (Debian suite) _))+					| not (isStable suite) -> ensureProperty w $+						unattendedconfig+							`File.containsLine`+						("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")+				_ -> noChange+		unattendedconfig = "/etc/apt/apt.conf.d/50unattended-upgrades" +-- | Enable periodic updates (but not upgrades), including download+-- of packages.+periodicUpdates :: Property DebianLike+periodicUpdates = tightenTargets $ "/etc/apt/apt.conf.d/02periodic" `File.hasContent`+	[ "APT::Periodic::Enable \"1\";"+	, "APT::Periodic::Update-Package-Lists \"1\";"+	, "APT::Periodic::Download-Upgradeable-Packages \"1\";"+	, "APT::Periodic::Verbose \"1\";"+	]+ type DebconfTemplate = String type DebconfTemplateType = String type DebconfTemplateValue = String@@ -265,8 +282,8 @@ -- | Preseeds debconf values and reconfigures the package so it takes -- effect. reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike-reConfigure package vals = tightenTargets $ -	reconfigure +reConfigure package vals = tightenTargets $+	reconfigure 		`requires` setselections 		`describe` ("reconfigure " ++ package)   where

@@ -0,0 +1,147 @@+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>++module Propellor.Property.Attic+	( installed+	, repoExists+	, init+	, restored+	, backup+	, KeepPolicy (..)+	) where++import Propellor.Base hiding (init)+import Prelude hiding (init)+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.Cron as Cron+import Data.List (intercalate)++type AtticParam = String++type AtticRepo = FilePath++installed :: Property DebianLike+installed = Apt.installed ["attic"]++repoExists :: AtticRepo -> IO Bool+repoExists repo = boolSystem "attic" [Param "list", File repo]++-- | Inits a new attic repository+init :: AtticRepo -> Property DebianLike+init backupdir = check (not <$> repoExists backupdir) (cmdProperty "attic" initargs)+	`requires` installed+  where+	initargs =+		[ "init"+		, backupdir+		]++-- | Restores a directory from an attic backup.+--+-- Only does anything if the directory does not exist, or exists,+-- but is completely empty.+--+-- The restore is performed atomically; restoring to a temp directory+-- and then moving it to the directory.+restored :: FilePath -> AtticRepo -> Property DebianLike+restored dir backupdir = go `requires` installed+  where+	go :: Property DebianLike+	go = property (dir ++ " restored by attic") $ ifM (liftIO needsRestore)+		( do+			warningMessage $ dir ++ " is empty/missing; restoring from backup ..."+			liftIO restore+		, noChange+		)++	needsRestore = null <$> catchDefaultIO [] (dirContents dir)++	restore = withTmpDirIn (takeDirectory dir) "attic-restore" $ \tmpdir -> do+		ok <- boolSystem "attic" $+			[ Param "extract"+			, Param backupdir+			, Param tmpdir+			]+		let restoreddir = tmpdir ++ "/" ++ dir+		ifM (pure ok <&&> doesDirectoryExist restoreddir)+			( do+				void $ tryIO $ removeDirectory dir+				renameDirectory restoreddir dir+				return MadeChange+			, return FailedChange+			)++-- | Installs a cron job that causes a given directory to be backed+-- up, by running attic with some parameters.+--+-- If the directory does not exist, or exists but is completely empty,+-- this Property will immediately restore it from an existing backup.+--+-- So, this property can be used to deploy a directory of content+-- to a host, while also ensuring any changes made to it get backed up.+-- For example:+--+-- >	& Attic.backup "/srv/git" "root@myserver:/mnt/backup/git.attic" Cron.Daily+-- >		["--exclude=/srv/git/tobeignored"]+-- >		[Attic.KeepDays 7, Attic.KeepWeeks 4, Attic.KeepMonths 6, Attic.KeepYears 1]+--+-- Note that this property does not make attic encrypt the backup+-- repository.+--+-- Since attic uses a fair amount of system resources, only one attic+-- backup job will be run at a time. Other jobs will wait their turns to+-- run.+backup :: FilePath -> AtticRepo -> Cron.Times -> [AtticParam] -> [KeepPolicy] -> Property DebianLike+backup dir backupdir crontimes extraargs kp = backup' dir backupdir crontimes extraargs kp+	`requires` restored dir backupdir++-- | Does a backup, but does not automatically restore.+backup' :: FilePath -> AtticRepo -> Cron.Times -> [AtticParam] -> [KeepPolicy] -> Property DebianLike+backup' dir backupdir crontimes extraargs kp = cronjob+	`describe` desc+	`requires` installed+  where+	desc = backupdir ++ " attic backup"+	cronjob = Cron.niceJob ("attic_backup" ++ dir) crontimes (User "root") "/" $+		"flock " ++ shellEscape lockfile ++ " sh -c " ++ backupcmd+	lockfile = "/var/lock/propellor-attic.lock"+	backupcmd = intercalate ";" $+		createCommand+		: if null kp then [] else [pruneCommand]+	createCommand = unwords $+		[ "attic"+		, "create"+		, "--stats"+		]+		++ map shellEscape extraargs +++		[ shellEscape backupdir ++ "::" ++ "$(date --iso-8601=ns --utc)"+		, shellEscape dir+		]+	pruneCommand = unwords $+		[ "attic"+		, "prune"+		, shellEscape backupdir+		]+		+++		map keepParam kp++-- | Constructs an AtticParam that specifies which old backup generations to+-- keep. By default, all generations are kept. However, when this parameter is+-- passed to the `backup` property, they will run attic prune to clean out+-- generations not specified here.+keepParam :: KeepPolicy -> AtticParam+keepParam (KeepHours n) = "--keep-hourly=" ++ show n+keepParam (KeepDays n) = "--keep-daily=" ++ show n+keepParam (KeepWeeks n) = "--keep-daily=" ++ show n+keepParam (KeepMonths n) = "--keep-monthly=" ++ show n+keepParam (KeepYears n) = "--keep-yearly=" ++ show n++-- | Policy for backup generations to keep. For example, KeepDays 30 will+-- keep the latest backup for each day when a backup was made, and keep the+-- last 30 such backups. When multiple KeepPolicies are combined together,+-- backups meeting any policy are kept. See attic's man page for details.+data KeepPolicy+	= KeepHours Int+	| KeepDays Int+	| KeepWeeks Int+	| KeepMonths Int+	| KeepYears Int

@@ -6,7 +6,6 @@ import Utility.Env import Utility.Directory -import System.Directory import Control.Applicative import Prelude 

@@ -30,6 +30,7 @@ import qualified Propellor.Property.Apt as Apt import Propellor.Property.Parted import Propellor.Property.Mount+import Propellor.Property.Fstab (SwapPartition(..), genFstab) import Propellor.Property.Partition import Propellor.Property.Rsync import Propellor.Container

@@ -0,0 +1,111 @@+module Propellor.Property.Fstab (+	FsType,+	Source,+	MountPoint,+	MountOpts(..),+	module Propellor.Property.Fstab,+) where++import Propellor.Base+import qualified Propellor.Property.File as File+import Propellor.Property.Mount++import Data.Char+import Data.List+import Utility.Table++-- | Ensures that </etc/fstab> contains a line mounting the specified+-- `Source` on the specified `MountPoint`, and that it's currently mounted.+--+-- For example:+--+-- > mounted "auto" "/dev/sdb1" "/srv" mempty+--+-- Note that if anything else is already mounted at the `MountPoint`, it+-- will be left as-is by this property.+mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property Linux+mounted fs src mnt opts = tightenTargets $+	"/etc/fstab" `File.containsLine` l+		`describe` (mnt ++ " mounted by fstab")+		`onChange` mountnow+  where+	l = intercalate "\t" [src, mnt, fs, formatMountOpts opts, dump, passno]+	dump = "0"+	passno = "2"+	-- This use of mountPoints, which is linux-only, is why this+	-- property currently only supports linux.+	mountnow = check (notElem mnt <$> mountPoints) $+		cmdProperty "mount" [mnt]++newtype SwapPartition = SwapPartition FilePath++-- | Replaces </etc/fstab> with a file that should cause the currently+-- mounted partitions to be re-mounted the same way on boot.+--+-- For each specified MountPoint, the UUID of each partition+-- (or if there is no UUID, its label), its filesystem type,+-- and its mount options are all automatically probed.+--+-- The SwapPartitions are also included in the generated fstab.+fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux+fstabbed mnts swaps = property' "fstabbed" $ \o -> do+	fstab <- liftIO $ genFstab mnts swaps id+	ensureProperty o $ +		"/etc/fstab" `File.hasContent` fstab++genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String]+genFstab mnts swaps mnttransform = do+	fstab <- liftIO $ mapM getcfg (sort mnts)+	swapfstab <- liftIO $ mapM getswapcfg swaps+	return $ header ++ formatTable (legend : fstab ++ swapfstab)+  where+	header =+		[ "# /etc/fstab: static file system information. See fstab(5)"+		, "# "+		]+	legend = ["# <file system>", "<mount point>", "<type>", "<options>", "<dump>", "<pass>"]+	getcfg mnt = sequence+		[ fromMaybe (error $ "unable to find mount source for " ++ mnt)+			<$> getM (\a -> a mnt)+				[ uuidprefix getMountUUID+				, sourceprefix getMountLabel+				, getMountSource+				]+		, pure (mnttransform mnt)+		, fromMaybe "auto" <$> getFsType mnt+		, formatMountOpts <$> getFsMountOpts mnt+		, pure "0"+		, pure (if mnt == "/" then "1" else "2")+		]+	getswapcfg (SwapPartition swap) = sequence+		[ fromMaybe swap <$> getM (\a -> a swap)+			[ uuidprefix getSourceUUID+			, sourceprefix getSourceLabel+			]+		, pure "none"+		, pure "swap"+		, pure (formatMountOpts mempty)+		, pure "0"+		, pure "0"+		]+	prefix s getter m = fmap (s ++) <$> getter m+	uuidprefix = prefix "UUID="+	sourceprefix = prefix "LABEL="++-- | Checks if </etc/fstab> is not configured. +-- This is the case if it doesn't exist, or+-- consists entirely of blank lines or comments.+--+-- So, if you want to only replace the fstab once, and then never touch it+-- again, allowing local modifications:+--+-- > check noFstab (fstabbed mnts [])+noFstab :: IO Bool+noFstab = ifM (doesFileExist "/etc/fstab")+	( null . filter iscfg . lines <$> readFile "/etc/fstab"+	, return True+	)+  where+	iscfg l+		| null l = False+		| otherwise = not $ "#" `isPrefixOf` dropWhile isSpace l

@@ -1,14 +1,15 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-} +-- | Properties in this module ensure that things are currently mounted,+-- but without making the mount persistent. Use `Propellor.Property.Fstab`+-- to configure persistent mounts.+ module Propellor.Property.Mount where  import Propellor.Base-import qualified Propellor.Property.File as File import Utility.Path -import Data.Char import Data.List-import Utility.Table  -- | type of filesystem to mount ("auto" to autodetect) type FsType = String@@ -20,6 +21,8 @@ type MountPoint = FilePath  -- | Filesystem mount options. Eg, MountOpts ["errors=remount-ro"]+--+-- For default mount options, use `mempty`. newtype MountOpts = MountOpts [String] 	deriving Monoid @@ -36,7 +39,7 @@ formatMountOpts (MountOpts []) = "defaults" formatMountOpts (MountOpts l) = intercalate "," l --- | Mounts a device.+-- | Mounts a device, without listing it in </etc/fstab>. mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike mounted fs src mnt opts = property (mnt ++ " mounted") $  	toResult <$> liftIO (mount fs src mnt opts)@@ -57,79 +60,6 @@ 	, Param mnt 	] -newtype SwapPartition = SwapPartition FilePath---- | Replaces </etc/fstab> with a file that should cause the currently--- mounted partitions to be re-mounted the same way on boot.------ For each specified MountPoint, the UUID of each partition--- (or if there is no UUID, its label), its filesystem type,--- and its mount options are all automatically probed.------ The SwapPartitions are also included in the generated fstab.-fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux-fstabbed mnts swaps = property' "fstabbed" $ \o -> do-	fstab <- liftIO $ genFstab mnts swaps id-	ensureProperty o $ -		"/etc/fstab" `File.hasContent` fstab--genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String]-genFstab mnts swaps mnttransform = do-	fstab <- liftIO $ mapM getcfg (sort mnts)-	swapfstab <- liftIO $ mapM getswapcfg swaps-	return $ header ++ formatTable (legend : fstab ++ swapfstab)-  where-	header =-		[ "# /etc/fstab: static file system information. See fstab(5)"-		, "# "-		]-	legend = ["# <file system>", "<mount point>", "<type>", "<options>", "<dump>", "<pass>"]-	getcfg mnt = sequence-		[ fromMaybe (error $ "unable to find mount source for " ++ mnt)-			<$> getM (\a -> a mnt)-				[ uuidprefix getMountUUID-				, sourceprefix getMountLabel-				, getMountSource-				]-		, pure (mnttransform mnt)-		, fromMaybe "auto" <$> getFsType mnt-		, formatMountOpts <$> getFsMountOpts mnt-		, pure "0"-		, pure (if mnt == "/" then "1" else "2")-		]-	getswapcfg (SwapPartition swap) = sequence-		[ fromMaybe swap <$> getM (\a -> a swap)-			[ uuidprefix getSourceUUID-			, sourceprefix getSourceLabel-			]-		, pure "none"-		, pure "swap"-		, pure (formatMountOpts mempty)-		, pure "0"-		, pure "0"-		]-	prefix s getter m = fmap (s ++) <$> getter m-	uuidprefix = prefix "UUID="-	sourceprefix = prefix "LABEL="---- | Checks if </etc/fstab> is not configured. --- This is the case if it doesn't exist, or--- consists entirely of blank lines or comments.------ So, if you want to only replace the fstab once, and then never touch it--- again, allowing local modifications:------ > check noFstab (fstabbed mnts [])-noFstab :: IO Bool-noFstab = ifM (doesFileExist "/etc/fstab")-	( null . filter iscfg . lines <$> readFile "/etc/fstab"-	, return True-	)-  where-	iscfg l-		| null l = False-		| otherwise = not $ "#" `isPrefixOf` dropWhile isSpace l-	 -- | Lists all mount points of the system. mountPoints :: IO [MountPoint] mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]

@@ -34,7 +34,6 @@ import qualified Data.Text.IO as T import Control.Applicative import Prelude-import System.Log.Logger  import Utility.Monad import Utility.Exception@@ -290,30 +289,18 @@ 	r@(_, _, _, h) <- P.createProcess p 		`onException` dropOutputLock 	registerOutputThread-	debug ["fgProcess", showProc p] 	-- Wait for the process to exit and drop the lock. 	asyncProcessWaiter $ do 		void $ tryIO $ P.waitForProcess h 		unregisterOutputThread 		dropOutputLock-		debug ["fgProcess done", showProc p] 	return (toConcurrentProcessHandle r)-	-debug :: [String] -> IO ()-debug = debugM "concurrent-output" . unwords -showProc :: P.CreateProcess -> String-showProc = go . P.cmdspec-  where-	go (P.ShellCommand s) = s-	go (P.RawCommand c ps) = show (c, ps)- #ifndef mingw32_HOST_OS bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle) bgProcess p = do 	(toouth, fromouth) <- pipe 	(toerrh, fromerrh) <- pipe-	debug ["bgProcess", showProc p] 	let p' = p 		{ P.std_out = rediroutput (P.std_out p) toouth 		, P.std_err = rediroutput (P.std_err p) toerrh

@@ -6,12 +6,15 @@  -}  {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-tabs #-}+{-# OPTIONS_GHC -fno-warn-tabs -w #-} -module Utility.Directory where+module Utility.Directory (+	module Utility.Directory,+	module System.Directory+) where  import System.IO.Error-import System.Directory+import System.Directory hiding (isSymbolicLink) import Control.Monad import System.FilePath import Control.Applicative@@ -134,11 +137,13 @@ 				_ <- tryIO $ removeFile tmp 				throwM e' +#ifndef mingw32_HOST_OS	 	isdir f = do 		r <- tryIO $ getFileStatus f 		case r of 			(Left _) -> return False 			(Right s) -> return $ isDirectory s+#endif  {- Removes a file, which may or may not exist, and does not have to  - be a regular file.

@@ -14,7 +14,6 @@ import Utility.Path  import Data.Maybe-import System.Directory import System.FilePath import Data.List.Utils import System.Posix.Files

@@ -12,7 +12,6 @@  import Data.String.Utils import System.FilePath-import System.Directory import Data.List import Data.Maybe import Data.Char@@ -29,6 +28,7 @@ import qualified "MissingH" System.Path as MissingH import Utility.Monad import Utility.UserInfo+import Utility.Directory  {- Simplifies a path, removing any "." component, collapsing "dir/..",   - and removing the trailing path separator.@@ -60,7 +60,7 @@ {- Makes a path absolute.  -  - The first parameter is a base directory (ie, the cwd) to use if the path- - is not already absolute.+ - is not already absolute, and should itsef be absolute.  -  - Does not attempt to deal with edge cases or ensure security with  - untrusted inputs.@@ -252,15 +252,21 @@   where 	f = takeFileName file -{- Converts a DOS style path to a Cygwin style path. Only on Windows.- - Any trailing '\' is preserved as a trailing '/' -}-toCygPath :: FilePath -> FilePath+{- 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-toCygPath = id+toMSYS2Path = id #else-toCygPath p+toMSYS2Path p 	| null drive = recombine parts-	| otherwise = recombine $ "/cygdrive" : driveletter drive : parts+	| otherwise = recombine $ "/" : driveletter drive : parts   where 	(drive, p') = splitDrive p 	parts = splitDirectories p'

@@ -13,10 +13,10 @@ import Propellor.Message import Propellor.Bootstrap import Utility.Monad+import Utility.Directory import Utility.Process import Utility.Process.NonConcurrent -import System.Directory import System.Environment (getArgs) import System.Exit import System.Posix.Directory