diff --git a/Setup.hs b/Setup.hs
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,5 +1,14 @@
 #!/usr/bin/runhaskell
 
 import Distribution.Simple
+import System.Cmd
+import System.Exit
 
-main = defaultMainWithHooks simpleUserHooks
+main = defaultMainWithHooks simpleUserHooks {
+         postBuild = runTestScript
+       , runTests = runTestScript
+       }
+
+runTestScript _args _flag _pd _lbi =
+    system "runhaskell Tests.hs" >>=
+    \ code -> if code == ExitSuccess then return () else error "Test Failure"
diff --git a/System/Unix/Chroot.hs b/System/Unix/Chroot.hs
new file mode 100644
--- /dev/null
+++ b/System/Unix/Chroot.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+-- | This module, except for useEnv, is copied from the build-env package.
+module System.Unix.Chroot
+    ( fchroot
+    , useEnv
+    , forceList
+    , forceList'
+    ) where
+
+import Control.Exception (finally, evaluate)
+
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as L
+import Foreign.C.Error
+import Foreign.C.String
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (dropTrailingPathSeparator, dropFileName)
+import System.IO (hPutStr, stderr)
+import System.Posix.Env (getEnv)
+import System.Posix.IO
+import System.Posix.Directory
+import System.Unix.Process (Output(..))
+import System.Unix.Progress (lazyCommandF)
+import System.Unix.QIO (quieter, qPutStrLn)
+
+foreign import ccall unsafe "chroot" c_chroot :: CString -> IO Int
+
+-- |chroot changes the root directory to filepath
+-- NOTE: it does not change the working directory, just the root directory
+-- NOTE: will throw IOError if chroot fails
+chroot :: FilePath -> IO ()
+chroot fp = withCString fp $ \cfp -> throwErrnoIfMinus1_ "chroot" (c_chroot cfp)
+
+-- |fchroot runs an IO action inside a chroot
+-- fchroot performs a chroot, runs the action, and then restores the
+-- original root and working directory. This probably affects the
+-- chroot and working directory of all the threads in the process,
+-- so...
+-- NOTE: will throw IOError if internal chroot fails
+fchroot :: FilePath -> IO a -> IO a
+fchroot path action =
+    do origWd <- getWorkingDirectory
+       rootFd <- openFd "/" ReadOnly Nothing defaultFileFlags
+       chroot path
+       changeWorkingDirectory "/"
+       action `finally` (breakFree origWd rootFd)
+    where
+      breakFree origWd rootFd =
+          do changeWorkingDirectoryFd rootFd
+             closeFd rootFd
+             chroot "."
+             changeWorkingDirectory origWd
+
+-- |The ssh inside of the chroot needs to be able to talk to the
+-- running ssh-agent.  Therefore we mount --bind the ssh agent socket
+-- dir inside the chroot (and umount it when we exit the chroot.
+useEnv :: FilePath -> (a -> IO a) -> IO a -> IO a
+useEnv rootPath force action =
+    do -- In order to minimize confusion, this QIO message is output
+       -- at default quietness.  If you want to suppress it while seeing
+       -- the output from your action, you need to say something like
+       -- quieter (+ 1) (useEnv (quieter (\x->x-1) action))
+       qPutStrLn $ "Entering environment at " ++ rootPath
+       sockPath <- getEnv "SSH_AUTH_SOCK"
+       home <- getEnv "HOME"
+       copySSH home
+       -- We need to force the output before we exit the changeroot.
+       -- Otherwise we lose our ability to communicate with the ssh
+       -- agent and we get errors.
+       withSock sockPath . fchroot rootPath $ (action >>= force)
+    where
+      copySSH Nothing = return ()
+      copySSH (Just home) =
+          -- Do NOT preserve ownership, files must be owned by root.
+          system' ("rsync -rlptgDHxS --delete " ++ home ++ "/.ssh/ " ++ rootPath ++ "/root/.ssh")
+      withSock Nothing action = action
+      withSock (Just sockPath) action =
+          withMountBind dir (rootPath ++ dir) action
+          where dir = dropTrailingPathSeparator (dropFileName sockPath)
+      withMountBind toMount mountPoint action =
+          doMount
+          where
+            doMount =
+                do createDirectoryIfMissing True mountPoint
+                   system' $ "mount --bind " ++ escapePathForMount toMount ++ " " ++ escapePathForMount mountPoint
+                   result <- action
+                   system' $ "umount " ++ escapePathForMount mountPoint
+                   return result
+      escapePathForMount = id	-- FIXME - Path arguments should be escaped
+      system' s = lazyCommandF s L.empty >> return ()
+          -- system s >>= testcode
+          -- where testcode (ExitFailure n) = error (show s ++ " -> " ++ show n)
+          --       testcode ExitSuccess = return ()
+
+-- |A function to force the process output by examining it but not
+-- printing anything.
+forceList :: [a] -> IO [a]
+forceList output = evaluate (length output) >> return output
+
+-- |First send the process output to the and then force it.
+forceList' :: [Output] -> IO [Output]
+forceList' output = printOutput output >>= forceList
+
+-- |Print all the output to the appropriate output channel
+printOutput :: [Output] -> IO [Output]
+printOutput output =
+    mapM print output
+    where
+      print x@(Stdout s) = putStr (B.unpack s) >> return x
+      print x@(Stderr s) = hPutStr stderr (B.unpack s) >> return x
+      print x = return x
+
+{-
+printDots :: Int -> [Output] -> IO [Output]
+printDots cpd output =
+    foldM f 0 output >> return output
+    where
+      print rem (Stdout s) =
+          let (dots, rem') = quotRem (rem + length s) in
+          hPutStr stderr (replicate dots '.')
+          return rem'
+      print rem (Stderr s) = print rem (Stdout s)
+-}
diff --git a/System/Unix/Files.hs b/System/Unix/Files.hs
--- a/System/Unix/Files.hs
+++ b/System/Unix/Files.hs
@@ -1,7 +1,9 @@
 module System.Unix.Files where
 
-import System.Posix.Files
-import System.IO.Error
+import Control.Exception (catch)
+import Prelude hiding (catch)
+import System.Posix.Files (createSymbolicLink, removeLink)
+import System.IO.Error (isAlreadyExistsError)
 
 -- |calls 'createSymbolicLink' but will remove the target and retry if
 -- 'createSymbolicLink' raises EEXIST.
diff --git a/System/Unix/Misc.hs b/System/Unix/Misc.hs
--- a/System/Unix/Misc.hs
+++ b/System/Unix/Misc.hs
@@ -7,7 +7,9 @@
     where
 
 import Control.Exception
-import Data.ByteString.Lazy.Char8 (empty)
+import qualified Codec.Compression.GZip
+import Data.ByteString.Lazy.Char8 (empty, readFile, writeFile)
+import Data.Digest.Pure.MD5 (md5)
 import Data.Maybe
 import System.Cmd
 import System.Directory
@@ -17,8 +19,10 @@
 import System.Process
 import System.Unix.Process
 
+{-# DEPRECATED md5sum "Use Data.ByteString.Lazy.Char8.readFile path >>= return . show . Data.Digest.Pure.MD5.md5" #-}
 md5sum :: FilePath -> IO String
-md5sum path =
+md5sum path = Data.ByteString.Lazy.Char8.readFile path >>= return . show . md5
+{-
     do
       (text, _, exitCode) <- lazyProcess "md5sum" [path] Nothing Nothing empty >>= return . collectOutputUnpacked
       let output = listToMaybe (words text)
@@ -28,12 +32,15 @@
               Nothing -> error ("Error in output of 'md5sum " ++ path ++ "'")
               Just checksum -> return checksum
         _ -> error ("Error running 'md5sum " ++ path ++ "'")
+-}
 
-{-# WARNING gzip "System.Unix.Misc.gzip does not properly escape its path arguments" #-}
+{-# DEPRECATED gzip "Use Data.ByteString.Lazy.Char8.readFile path >>= Data.ByteString.Lazy.Char8.writeFile (path ++ \".gz\")" #-}
 gzip :: FilePath -> IO ()
-gzip path =
+gzip path = Data.ByteString.Lazy.Char8.readFile path >>= Data.ByteString.Lazy.Char8.writeFile (path ++ ".gz")
+{-
     do
       result <- system ("gzip < " ++ path ++ " > " ++ path ++ ".gz")
       case result of
         ExitSuccess -> return ()
         e -> error (show e)
+-}
diff --git a/System/Unix/Mount.hs b/System/Unix/Mount.hs
--- a/System/Unix/Mount.hs
+++ b/System/Unix/Mount.hs
@@ -12,15 +12,17 @@
 import Data.List
 import System.Directory
 import System.Exit
+import System.IO (readFile)
 import System.Posix.Files
 import System.Unix.Process
+import System.Unix.QIO (quieter, qPutStrLn)
 
 -- Local Modules
 
 import System.Unix.Process
 
 -- In ghc610 readFile "/proc/mounts" hangs.  Use this instead.
-rf path = lazyCommand ("cat '" ++ path ++ "'") empty >>= return . (\ (o, _, _) -> o) . collectOutputUnpacked
+-- rf path = lazyCommand ("cat '" ++ path ++ "'") empty >>= return . (\ (o, _, _) -> o) . collectOutputUnpacked
 
 -- |'umountBelow' - unmounts all mount points below /belowPath/
 -- \/proc\/mounts must be present and readable.  Because of the way
@@ -44,21 +46,26 @@
 -- in \/proc\/mounts, which means we need to run "umount \/proc\/bus\/usb".
 --
 -- See also: 'umountSucceeded'
-umountBelow :: FilePath -- ^ canonicalised, absolute path
+umountBelow :: Bool     -- ^ Lazy (umount -l flag) if true
+            -> FilePath -- ^ canonicalised, absolute path
             -> IO [(FilePath, (String, String, ExitCode))] -- ^ paths that we attempted to umount, and the responding output from the umount command
-umountBelow belowPath =
-    do procMount <- rf "/proc/mounts"
+umountBelow lazy belowPath = quieter (\x->x-9) $
+    do procMount <- readFile "/proc/mounts"
        let mountPoints = map (unescape . (!! 1) . words) (lines procMount)
            maybeMounts = filter (isPrefixOf belowPath) (concat (map tails mountPoints))
+           args path = ["-f"] ++ if lazy then ["-l"] else [] ++ [path]
        needsUmount <- filterM isMountPoint maybeMounts
-       result <- mapM (\path -> umount [path,"-f","-l"] >>= return . ((,) path)) needsUmount
+       results <- mapM (\ path -> qPutStrLn ("umountBelow: umount " ++ intercalate " " (args path)) >> umount (args path) >>= return . ((,) path)) needsUmount
+       let results' = map fixNotMounted results
+       mapM_ (\ (result, result') -> qPutStrLn (show result ++ (if result /= result' then " -> " ++ show result' else ""))) (zip results results')
        -- Did /proc/mounts change?  If so we should try again because
        -- nested mounts might have been revealed.
-       procMount' <- rf "/proc/mounts"
-       result' <- if procMount /= procMount' then
-                      umountBelow belowPath else
-                      return []
-       return $ result ++ result'
+       procMount' <- readFile "/proc/mounts"
+       results'' <- if procMount /= procMount' then umountBelow lazy belowPath else return []
+       return $ results' ++ results''
+    where
+      fixNotMounted (path, ("", err, ExitFailure 1)) | err == ("umount: " ++ path ++ ": not mounted\n") = (path, ("", "" , ExitSuccess))
+      fixNotMounted x = x
 
 -- |umountSucceeded - predicated suitable for filtering results of 'umountBelow'
 umountSucceeded :: (FilePath, (String, String, ExitCode)) -> Bool
diff --git a/System/Unix/Process.hs b/System/Unix/Process.hs
--- a/System/Unix/Process.hs
+++ b/System/Unix/Process.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures -Werror #-}
+{-# OPTIONS -Wwarn -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures #-}
 -- |functions for killing processes, running processes, etc
 module System.Unix.Process
     (
diff --git a/System/Unix/Progress.hs b/System/Unix/Progress.hs
--- a/System/Unix/Progress.hs
+++ b/System/Unix/Progress.hs
@@ -1,38 +1,28 @@
+-- | Support for changing the output of a lazyCommand in several ways:
+-- 
+--     * Output a dot for every 128 characters of the original output
+-- 
+--     * Increase the quietness level before running the command
+-- 
+--     * Output only if (and when) the command fails
+-- 
+--     * Throw an exception if the command fails
+-- 
+--     * No output
 {-# LANGUAGE FlexibleContexts, PackageImports, RankNTypes, ScopedTypeVariables #-}
-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
--- |Control the progress reporting and output of subprocesses.
+{-# OPTIONS -Wall -Werror -fno-warn-name-shadowing #-}
 module System.Unix.Progress
     ( -- * The Progress Monad
-      Progress
-    , ProgressFlag(..)
-    , quietnessLevels
-    , runProgress
+      ProgressFlag(..)
     -- * Process launching
     , lazyCommandP
     , lazyProcessP
-    -- * Quietness control
-    , defaultQuietness
-    , modQuietness
-    , quieter
-    -- * Output stream processing
-    -- , prefixes
-    -- , printOutput
-    -- , dotOutput
     , timeTask
     , showElapsed
-    , ePutStr
-    , ePutStrLn
-    , qPutStr
-    , qPutStrLn
-    , eMessage
-    , eMessageLn
-    , qMessage
-    , qMessageLn
     -- * Unit tests
     , tests
     -- * A set of lazyCommand functions for an example set of verbosity levels
-    , defaultLevels
-    , lazyCommandV -- Print everything
+    , lazyCommandV -- Print everything - command, stdout, stderr, result
     , lazyProcessV
     , lazyCommandF -- Like V, but throws exception on failure
     , lazyProcessF
@@ -40,36 +30,24 @@
     , lazyProcessE
     , lazyCommandEF -- E and F combo
     , lazyProcessEF
-    , lazyCommandD -- Dots
-    , lazyCommandQ -- Quiet
-    , lazyCommandS -- Silent
-    , lazyCommandSF
     ) where
 
-import Control.Exception (evaluate, try, SomeException)
-import Control.Monad (when)
-import Control.Monad.State (StateT, get, evalStateT)
-import "mtl" Control.Monad.Trans ( MonadIO, liftIO, lift )
-import Data.Array ((!), array, bounds)
+import Control.Exception (evaluate)
+import "mtl" Control.Monad.Trans ( MonadIO, liftIO )
 import qualified Data.ByteString.Internal as B
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as L
 import Data.List (intercalate)
 import qualified Data.Set as Set
 import Data.Time (NominalDiffTime, getCurrentTime, diffUTCTime)
-import System.Environment (getArgs, getEnv)
 import System.Exit (ExitCode(..))
-import System.IO (hPutStrLn, stderr, hPutStr)
-import System.Posix.Env (setEnv)
 import System.Unix.Process (lazyProcess, lazyCommand, Output(Stdout, Stderr),
                             exitCodeOnly, stdoutOnly, mergeToStdout)
+import System.Unix.QIO (quietness, ePutStr, ePutStrLn, qPutStr)
 import Test.HUnit
 
 type ProgressState = Set.Set ProgressFlag
 
--- |A monad for controlling progress reporting of subprocesses.
-type Progress m a = MonadIO m => StateT ProgressState m a
-
 -- |The flags that control what type of output will be sent to stdout
 -- and stderr.  Also, the ExceptionOnFail flag controls whether an
 -- exception will be thrown if the @ExitCode@ is not @ExitSuccess@.
@@ -79,13 +57,77 @@
     | All
     | Errors
     | Result
-    | EchoOnFail
-    | AllOnFail
+    | EchoOnFail      -- ^ If Echo is present this has no effect
+    | AllOnFail       -- ^ If All is present this has no effect
     | ErrorsOnFail
     | ResultOnFail
     | ExceptionOnFail
     deriving (Ord, Eq)
 
+lazyCommandV :: MonadIO m => String -> L.ByteString -> m [Output]
+lazyCommandV cmd input =
+    progressFlags Set.empty >>= lazyCommandP cmd input
+
+lazyProcessV :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> m [Output]
+lazyProcessV cmd args wd env input =
+    progressFlags Set.empty >>= lazyProcessP cmd args wd env input
+
+lazyCommandF :: MonadIO m => String -> L.ByteString -> m [Output]
+lazyCommandF cmd input =
+    progressFlags (Set.fromList [ExceptionOnFail]) >>= lazyCommandP cmd input
+
+lazyProcessF :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> m [Output]
+lazyProcessF cmd args wd env input =
+    progressFlags (Set.fromList [ExceptionOnFail]) >>= lazyProcessP cmd args wd env input
+
+lazyCommandE :: MonadIO m => String -> L.ByteString -> m [Output]
+lazyCommandE cmd input =
+    progressFlags (Set.fromList [EchoOnFail, AllOnFail, ResultOnFail]) >>= lazyCommandP cmd input
+
+lazyProcessE :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> m [Output]
+lazyProcessE cmd args wd env input =
+    progressFlags (Set.fromList [EchoOnFail, AllOnFail, ResultOnFail]) >>= lazyProcessP cmd args wd env input
+
+lazyCommandEF :: MonadIO m => String -> L.ByteString -> m [Output]
+lazyCommandEF cmd input =
+    progressFlags (Set.fromList [EchoOnFail, AllOnFail, ResultOnFail, ExceptionOnFail]) >>= lazyCommandP cmd input
+
+lazyProcessEF :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> m [Output]
+lazyProcessEF cmd args wd env input =
+    progressFlags (Set.fromList [EchoOnFail, AllOnFail, ResultOnFail, ExceptionOnFail]) >>= lazyProcessP cmd args wd env input
+
+-- A usable example of the construction of a verbosity level
+-- specification.  You can supply your own defaultLevels list and
+-- build the flags* and lazyCommand* functions in a similar way.
+
+-- |Normally (when quietness is 0) we see the command echoed and dots
+-- for progress indication.  If quietness is -1 we also see the
+-- command's output as it runs.  If quietness is 1 we don't see the
+-- dots or the result code, and if it is 2 we don't see anything.
+progressFlags :: MonadIO m => Set.Set ProgressFlag -> m (Set.Set ProgressFlag)
+progressFlags extra =
+    quietness >>= return . merge extra . Set.fromList . flags
+    where
+      flags n | n < 0 = [Echo, All, Result]
+      flags 0 = [Echo, Dots, Result]
+      flags 1 = [Echo]
+      flags _ = []
+      merge extra flags =
+          (if Set.member All flags then Set.delete AllOnFail else id) .
+          (if Set.member Echo flags then Set.delete EchoOnFail else id) .
+          (if Set.member Result flags then Set.delete ResultOnFail else id) $ Set.union extra flags
+
+{-
+defaultLevels :: Int -> Set.Set ProgressFlag
+defaultLevels n =
+    if n < 0 then default
+    where
+      levels = map Set.fromList
+               [ [Echo, All, Result]  -- when quietness == 0
+               , [Echo, Dots, Result] -- when quietness == 1
+               , [Echo]               -- when quietness == 2
+               , [] ]                 -- when quietness == 2
+
 -- |Create a function that returns the flags used for a given
 -- quietness level.
 quietnessLevels :: [Set.Set ProgressFlag] -> Int -> Set.Set ProgressFlag
@@ -93,88 +135,77 @@
     a ! (min r . max l $ i)
     where a = array (0, length flagLists - 1) (zip [0..] flagLists)
           (l, r) = bounds a
+-}
 
+{-
+-- |A monad for controlling progress reporting of subprocesses.
+type Progress m a = MonadIO m => StateT ProgressState m a
+
 -- |Run the Progress monad with the given flags.  The flag set is
 -- compute from the current quietness level, <= 0 the most verbose
 -- and >= 3 the least.
 runProgress :: MonadIO m =>
-               (Int -> Set.Set ProgressFlag)
             -> Progress m a      -- ^ The progress task to be run
             -> m a
 runProgress flags action =
     quietness >>= evalStateT action . flags
-
-lazyCommandP :: MonadIO m => (Int -> Set.Set ProgressFlag) -> String -> L.ByteString -> m [Output]
-lazyCommandP flags cmd input =
-    runProgress flags (lift (lazyCommand cmd input) >>= doProgress cmd)
-
-lazyProcessP :: MonadIO m => (Int -> Set.Set ProgressFlag) -> FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> m [Output]
-lazyProcessP flags exec args cwd env input =
-    runProgress flags (lift (lazyProcess exec args cwd env input) >>= doProgress (intercalate " " (exec : args)))
-
--- |Look for occurrences of -v and -q in the command line arguments
--- and the current values of environment variables VERBOSITY and
--- QUIETNESS to compute a new value for QUIETNESS.  If you want to
--- ignore the current QUIETNESS value say @setQuietness 0 >>
--- computeQuietness@.
-defaultQuietness :: MonadIO m => m Int
-defaultQuietness = liftIO $
-    do v1 <- try (getEnv "VERBOSITY" >>= return . read) >>= either (\ (_ :: SomeException) -> return 0) return
-       v2 <- getArgs >>= return . length . filter (== "-v")
-       q1 <- try (getEnv "QUIETNESS" >>= return . read) >>= either (\ (_ :: SomeException) -> return 0) return
-       q2 <- getArgs >>= return . length . filter (== "-q")
-       return $ q1 - v1 + q2 - v2
-
--- |Look at the number of -v and -q arguments to get the baseline
--- quietness / verbosity level for progress reporting.
-quietness :: MonadIO m => m Int
-quietness = liftIO (try (getEnv "QUIETNESS" >>= return . read)) >>=
-            either (\ (_ :: SomeException) -> return 0) return
+-}
 
--- |Perform a task with the given quietness level.
-modQuietness :: MonadIO m => (Int -> Int) -> m a -> m a
-modQuietness f task =
-    quietness >>= \ q0 ->
-    setQuietness (f q0) >>
-    task >>= \ result ->
-    setQuietness q0 >>
-    return result
-    where
-      -- Set the value of QUIETNESS in the environment.
-      setQuietness :: MonadIO m => Int -> m ()
-      setQuietness q = liftIO $ setEnv "QUIETNESS" (show q) True
+-- |The @P@ versions are the most general cases, here you can specify
+-- a function that turns the quietness level into any set of progress
+-- flags you like.
+lazyCommandP :: MonadIO m => String -> L.ByteString -> Set.Set ProgressFlag -> m [Output]
+lazyCommandP cmd input flags =
+    liftIO (lazyCommand cmd input) >>= doProgress flags cmd
 
--- |Do an IO task with additional -v or -q arguments so that the
--- progress reporting becomes more or less verbose.
-quieter :: MonadIO m => Int -> m a -> m a
-quieter q task = modQuietness (+ q) task
+lazyProcessP :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> Set.Set ProgressFlag -> m [Output]
+lazyProcessP exec args cwd env input flags =
+    liftIO (lazyProcess exec args cwd env input) >>= doProgress flags (intercalate " " (exec : args))
 
--- |Inject a command's output into the Progress monad, handling command echoing,
--- output formatting, result code reporting, and exception on failure.
-doProgress :: MonadIO m => String -> [Output] -> Progress m [Output]
-doProgress cmd output =
-    get >>= \ s ->
-    doEcho s output >>= doOutput s >>= doResult s >>= doFail s
+-- |Inject a command's output into the Progress monad, handling
+-- command echoing, output formatting, result code reporting, and
+-- exception on failure.  The flag set we get from the monad already
+-- reflects the program's current quietness level, so calling quieter
+-- and using the qPutStr functions here is not necessary.
+doProgress :: MonadIO m => ProgressState -> String -> [Output] -> m [Output]
+doProgress flags cmd output =
+    doEcho flags output >>= doOutput flags >>= doFailOutput flags >>= doResult flags >>= doFail flags
     where
-      doEcho s output
-          | Set.member Echo s || (Set.member EchoOnFail s && exitCodeOnly output /= ExitSuccess) =
-              liftIO (ePutStrLn ("-> " ++ cmd)) >> return output
+      doEcho flags output
+          | Set.member Echo flags =
+              ePutStrLn ("-> " ++ cmd) >> return output
+          | Set.member EchoOnFail flags && exitCodeOnly output /= ExitSuccess =
+              ePutStrLn ("-> " ++ cmd) >> return output
           | True = return output
-      doOutput s output
-          | Set.member All s || (Set.member AllOnFail s && exitCodeOnly output /= ExitSuccess) =
-              liftIO (printOutput (prefixes opre epre output))
-          | Set.member Dots s =
-              liftIO (dotOutput 128 output)
-          | Set.member Errors s || (Set.member ErrorsOnFail s && exitCodeOnly output /= ExitSuccess) =
-              liftIO (printErrors (prefixes opre epre output))
+      doOutput flags output
+          | Set.member All flags =
+              printOutput (prefixes opre epre output)
+          | Set.member Dots flags =
+              dotOutput 128 output
+          | Set.member Errors flags =
+              printErrors (prefixes opre epre output)
           | True = return output
-      doResult s output
-          | Set.member Result s || (Set.member ResultOnFail s && exitCodeOnly output /= ExitSuccess) =
-              liftIO (ePutStrLn ("<- " ++ show (exitCodeOnly output))) >> return output
+      doFailOutput flags output
+          | Set.member All flags =
+              return output
+          | Set.member AllOnFail flags && exitCodeOnly output /= ExitSuccess =
+              ePutStrLn ("*** FAILURE: " ++ cmd ++ " -> " ++ show (exitCodeOnly output)) >>
+              printOutput (prefixes opre epre output)
+          | Set.member Errors flags =
+              return output
+          | Set.member ErrorsOnFail flags && exitCodeOnly output /= ExitSuccess =
+              ePutStrLn ("*** FAILURE: " ++ cmd ++ " -> " ++ show (exitCodeOnly output)) >>
+              printErrors (prefixes opre epre output)
+          | True =
+              return output
+      doResult flags output
+          | Set.member Result flags =
+              ePutStrLn ("<- " ++ show (exitCodeOnly output)) >> return output
+          | Set.member ResultOnFail flags && exitCodeOnly output /= ExitSuccess =
+              ePutStrLn ("<- " ++ show (exitCodeOnly output)) >> return output
           | True = return output
-      doFail :: MonadIO m => ProgressState -> [Output] -> Progress m [Output]
-      doFail s output
-          | Set.member ExceptionOnFail s =
+      doFail flags output
+          | Set.member ExceptionOnFail flags =
               case exitCodeOnly output of
                 ExitSuccess -> return output
                 result -> fail ("*** FAILURE: " ++ cmd ++ " -> " ++ show result)
@@ -185,7 +216,7 @@
 -- |Print one dot to stderr for every COUNT characters of output.
 dotOutput :: MonadIO m => Int -> [Output] -> m [Output]
 dotOutput groupSize output =
-    mapM (\ (count, elem) -> ePutStr (replicate count '.') >> return elem) pairs >>= eMessageLn ""
+    ePutStr "." >> mapM (\ (count, elem) -> ePutStr (replicate count '.') >> return elem) pairs >>= \ x -> ePutStr ".\n" >> return x
     where
       pairs = zip (dots 0 (map length output)) output
       dots _ [] = []
@@ -229,7 +260,7 @@
     mapM (liftIO . print') output
     where
       print' (x, y) = print y >> return x
-      print (Stdout s) = putStr (B.unpack s)
+      print (Stdout s) = liftIO $ putStr (B.unpack s)
       print (Stderr s) = ePutStr (B.unpack s)
       print _ = return ()
 
@@ -254,7 +285,7 @@
 showElapsed :: MonadIO m => String -> m a -> m a
 showElapsed label f =
     do (result, time) <- timeTask f
-       ePutStr (label ++ formatTime' time)
+       qPutStr (label ++ formatTime' time)
        return result
 
 formatTime' :: NominalDiffTime -> String
@@ -272,39 +303,6 @@
       toMilliseconds f = round (f * 1000)
 -}
 
--- |Send a string to stderr.
-ePutStr :: MonadIO m => String -> m ()
-ePutStr = liftIO . hPutStr stderr
-
--- |@ePutStr@ with a terminating newline.
-ePutStrLn :: MonadIO m => String -> m ()
-ePutStrLn = liftIO . hPutStrLn stderr
-
--- |If the current quietness level is less than one print a message.
--- Control the quietness level using @quieter@.
-qPutStr :: MonadIO m => String -> m ()
-qPutStr s = quietness >>= \ q -> when (q < 0) (ePutStr s)
-
--- |@qPutStr@ with a terminating newline.
-qPutStrLn :: MonadIO m => String -> m ()
-qPutStrLn s = quietness >>= \ q -> when (q < 0) (ePutStrLn s)
-
--- |Print a message and return the second argument unevaluated.
-eMessage :: MonadIO m => String -> a -> m a
-eMessage message output = ePutStr message >> return output
-
--- |@eMessage@ with a terminating newline.
-eMessageLn :: MonadIO m => String -> a -> m a
-eMessageLn message output = ePutStrLn message >> return output
-
--- |@eMessage@ controlled by the quietness level.
-qMessage :: MonadIO m => String -> a -> m a
-qMessage message output = quietness >>= \ q -> when (q < 0) (ePutStr message) >> return output
-
--- |@qMessage@ with a terminating newline.
-qMessageLn :: MonadIO m => String -> a -> m a
-qMessageLn message output = quietness >>= \ q -> when (q < 0) (ePutStrLn message) >> return output
-
 -- |Unit tests.
 tests :: [Test]
 tests =
@@ -316,64 +314,3 @@
       p = B.pack
       collect :: [(Output, Output)] -> String
       collect = L.unpack . stdoutOnly . mergeToStdout . snd . unzip
-
--- A usable example of the construction of a verbosity level
--- specification.  You can supply your own defaultLevels list and
--- build the flags* and lazyCommand* functions in a similar way.
-
-defaultLevels :: [Set.Set ProgressFlag]
-defaultLevels =
-    map Set.fromList [ [Echo, All, Result]
-                     -- , [Echo, Errors, Result]
-                     , [Echo, Dots, Result]
-                     -- , [Echo, Result]
-                     , [Echo]
-                     , [] ]
-
-flags :: Int -> Set.Set ProgressFlag
-flags = quietnessLevels defaultLevels
-
-flagsF :: Int -> Set.Set ProgressFlag
-flagsF = quietnessLevels (map (Set.union (Set.fromList [ExceptionOnFail])) defaultLevels)
-
-flagsE :: Int -> Set.Set ProgressFlag
-flagsE = quietnessLevels (map (Set.union (Set.fromList [EchoOnFail, AllOnFail, ResultOnFail])) defaultLevels)
-
-flagsEF :: Int -> Set.Set ProgressFlag
-flagsEF = quietnessLevels (map (Set.union (Set.fromList [EchoOnFail, AllOnFail, ResultOnFail, ExceptionOnFail])) defaultLevels)
-
-lazyCommandV :: MonadIO m => String -> L.ByteString -> m [Output]
-lazyCommandV = lazyCommandP flags
-
-lazyProcessV :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> m [Output]
-lazyProcessV = lazyProcessP flags
-
-lazyCommandF :: MonadIO m => String -> L.ByteString -> m [Output]
-lazyCommandF = lazyCommandP flagsF
-
-lazyProcessF :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> m [Output]
-lazyProcessF = lazyProcessP flagsF
-
-lazyCommandE :: MonadIO m => String -> L.ByteString -> m [Output]
-lazyCommandE = lazyCommandP flagsE
-
-lazyProcessE :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> m [Output]
-lazyProcessE = lazyProcessP flagsE
-
-lazyCommandEF :: MonadIO m => String -> L.ByteString -> m [Output]
-lazyCommandEF = lazyCommandP flagsEF
-
-lazyProcessEF :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> L.ByteString -> m [Output]
-lazyProcessEF = lazyProcessP flagsEF
-
-lazyCommandD :: MonadIO m => String -> L.ByteString -> m [Output]
-lazyCommandD cmd input = quieter 1 $ lazyCommandP flagsE cmd input
-
-lazyCommandQ :: MonadIO m => String -> L.ByteString -> m [Output]
-lazyCommandQ cmd input = quieter 3 $ lazyCommandP flagsE cmd input
-
-lazyCommandS :: MonadIO m => String -> L.ByteString -> m [Output]
-lazyCommandS cmd input = quieter 4 $ lazyCommandP flagsE cmd input
-
-lazyCommandSF :: MonadIO m => String -> L.ByteString -> m [Output]
-lazyCommandSF cmd input = quieter 4 $ lazyCommandP flagsEF cmd input
diff --git a/System/Unix/QIO.hs b/System/Unix/QIO.hs
new file mode 100644
--- /dev/null
+++ b/System/Unix/QIO.hs
@@ -0,0 +1,132 @@
+-- | Functions to manage the verbosity of a console program by storing
+-- the quietness level in the system environment, specifically in the
+-- $QUIETNESS variable.  This lets you avoid creating a StateT monad
+-- to hold the quietness level.  Note that you don't attach a
+-- verbosity level to individual message commands, you control the
+-- quietness level for entire regions of your program and messages
+-- only appear when quietness is less than one.
+{-# LANGUAGE PackageImports, ScopedTypeVariables #-}
+{-# OPTIONS -Wall #-}
+module System.Unix.QIO
+    ( ePutStr
+    , ePutStrLn
+    , eMessage
+    , eMessageLn
+    -- * Get/set quietness levels
+    , initialQuietness
+    , quietness
+    -- * Do task with modified quietness level
+    -- , modQuietness
+    , quieter
+    , quieter'
+    -- , qZero
+    -- * Do a task if quietness < 1
+    , qDo
+    -- * Output to stderr when quietness < 1
+    , qPutStr
+    , qPutStrLn
+    , qMessage
+    , qMessageLn
+    -- * Some idioms
+    , q12
+    , q02
+    , v1
+    , v2
+    , v3
+    , showQ
+    ) where
+
+import Control.Exception (try, SomeException)
+import "mtl" Control.Monad.Trans ( MonadIO, liftIO )
+import System.Environment (getArgs, getEnv)
+import System.IO (hPutStrLn, stderr, hPutStr)
+import System.Posix.Env (setEnv)
+
+ePutStr :: MonadIO m => String -> m ()
+ePutStr s = liftIO $ hPutStr stderr s
+
+ePutStrLn :: MonadIO m => String -> m ()
+ePutStrLn s = liftIO $ hPutStrLn stderr s
+
+eMessage :: MonadIO m => String -> b -> m b
+eMessage s x = liftIO (hPutStr stderr s) >> return x
+
+eMessageLn :: MonadIO m => String -> b -> m b
+eMessageLn s x = liftIO (hPutStrLn stderr s) >> return x
+
+-- | Compute an initial value for $QUIETNESS by examining the
+-- $QUIETNESS and $VERBOSITY variables and counting the -v and -q
+-- options on the command line.
+initialQuietness :: MonadIO m => m Int
+initialQuietness = liftIO $
+    do v1 <- try (getEnv "VERBOSITY" >>= return . read) >>= either (\ (_ :: SomeException) -> return 0) return
+       v2 <- getArgs >>= return . length . filter (== "-v")
+       q1 <- try (getEnv "QUIETNESS" >>= return . read) >>= either (\ (_ :: SomeException) -> return 0) return
+       q2 <- getArgs >>= return . length . filter (== "-q")
+       return $ q1 - v1 + q2 - v2
+
+-- |Get the current quietness level from the QUIETNESS environment variable.
+quietness :: MonadIO m => m Int
+quietness = liftIO (try (getEnv "QUIETNESS" >>= return . read)) >>=
+            either (\ (_ :: SomeException) -> return 0) return
+
+-- |Perform a task with the quietness level tansformed by f.  Use
+-- @defaultQuietness >>= modQuietness . const@ to initialize the --
+-- verbosity for a program.
+quieter :: MonadIO m => (Int -> Int) -> m a -> m a
+quieter f task =
+    quietness >>= \ q0 ->
+    setQuietness (f q0) >>
+    task >>= \ result ->
+    setQuietness q0 >>
+    return result
+    where
+      -- Set the value of QUIETNESS in the environment.
+      setQuietness :: MonadIO m => Int -> m ()
+      setQuietness q = liftIO $ setEnv "QUIETNESS" (show q) True
+
+-- |Dummy version of quieter, sometimes you want to strip out all the
+-- quieter calls and see how things look, then restore them gradually.
+-- Use this to help remember where they were.
+quieter' :: MonadIO m => (Int -> Int) -> m a -> m a
+quieter' _ x = x
+
+-- |Peform a task only if quietness < 1.
+qDo :: MonadIO m => m () -> m ()
+qDo task = quietness >>= \ q -> if (q < 1) then task else return ()
+
+-- |If the current quietness level is less than one print a message.
+-- Control the quietness level using @quieter@.
+qPutStr :: MonadIO m => String -> m ()
+qPutStr s = qDo (ePutStr s)
+
+-- |@qPutStr@ with a terminating newline.
+qPutStrLn :: MonadIO m => String -> m ()
+qPutStrLn s = qDo (ePutStrLn s)
+
+-- |@eMessage@ controlled by the quietness level.
+qMessage :: MonadIO m => String -> a -> m a
+qMessage message output = qDo (ePutStr message) >> return output
+
+-- |@qMessage@ with a terminating newline.
+qMessageLn :: MonadIO m => String -> a -> m a
+qMessageLn message output = qDo (ePutStrLn message) >> return output
+
+-- |Print a message at quietness +1 and then do a task at quietness +3.
+-- This is a pattern which gives the following behaviors:
+-- Normally there is no output.  With -v only the messages are printed.
+-- With -v -v the messages and the shell commands are printed with dots
+-- to show progress.  With -v -v -v everything is printed.
+q12 :: MonadIO m => String -> m a -> m a
+q12 s a = quieter (+ 1) $ qPutStrLn s >> quieter (+ 2) a
+
+q02 :: MonadIO m => String -> m a -> m a
+q02 s a = qPutStrLn s >> quieter (+ 2) a
+
+v1 a = quieter (\x->x-1) a
+v2 a = quieter (\x->x-2) a
+v3 a = quieter (\x->x-3) a
+
+-- |For debugging
+showQ :: MonadIO m => String -> m a -> m a
+showQ s a = quietness >>= \ n -> ePutStrLn (s ++ ": quietness=" ++ show n) >> a
diff --git a/Unixutils.cabal b/Unixutils.cabal
--- a/Unixutils.cabal
+++ b/Unixutils.cabal
@@ -1,11 +1,11 @@
 Name:           Unixutils
-Version:        1.36
+Version:        1.44
 License:        BSD3
 License-File:	COPYING
 Author:         Jeremy Shaw, David Fox
 Homepage:       http://src.seereason.com/haskell-unixutils
 Category:	System
-Build-Depends:  array, base >= 4 && <5, containers, mtl, HUnit, unix, regex-tdfa, process < 3, bytestring, directory, time, old-time, parallel >= 2, filepath
+Build-Depends:  array, base >= 4 && <5, containers, mtl, HUnit, unix, regex-tdfa, process < 3, bytestring, directory, time, old-time, parallel >= 2, filepath, pureMD5, zlib
 Synopsis:       A crude interface between Haskell and Unix-like operating systems
 Maintainer:     jeremy@n-heptane.com
 Description:
@@ -14,9 +14,21 @@
 Build-type:	Simple
 ghc-options:	-O2
 Exposed-modules:
-        System.Unix.Crypt, System.Unix.Directory, System.Unix.FilePath, System.Unix.Misc, System.Unix.Mount,
-        System.Unix.Process, System.Unix.ProcessExtra, System.Unix.ProcessStrict,
-	System.Unix.Progress, System.Unix.OldProgress, System.Unix.Shadow, System.Unix.SpecialDevice, System.Unix.Files
+        System.Unix.Chroot,
+        System.Unix.Crypt,
+        System.Unix.Directory,
+        System.Unix.FilePath,
+        System.Unix.Misc,
+        System.Unix.Mount,
+        System.Unix.Process,
+        System.Unix.ProcessExtra,
+        System.Unix.ProcessStrict,
+        System.Unix.Progress,
+        System.Unix.OldProgress,
+        System.Unix.QIO,
+        System.Unix.Shadow,
+        System.Unix.SpecialDevice,
+        System.Unix.Files
 Extra-libraries: crypt
 
 -- For more complex build options see: