diff --git a/Distribution/ShellHarness.hs b/Distribution/ShellHarness.hs
new file mode 100644
--- /dev/null
+++ b/Distribution/ShellHarness.hs
@@ -0,0 +1,171 @@
+{-# OPTIONS_GHC -cpp #-}
+module Distribution.ShellHarness ( runTests ) where
+
+import Prelude hiding( catch )
+import System.Directory ( getCurrentDirectory, setPermissions,
+                          Permissions(..), getDirectoryContents,
+                          findExecutable, createDirectoryIfMissing )
+import System.Environment ( getEnv, getEnvironment )
+import System.Exit ( ExitCode (..), exitWith )
+import System.FilePath
+import System.IO
+import System.Process ( ProcessHandle, runInteractiveCommand,
+                        runInteractiveProcess, waitForProcess,
+                        getProcessExitCode )
+import Data.Maybe
+import Data.List ( isInfixOf, isPrefixOf, (\\), nubBy )
+import Control.Concurrent
+#if __GLASGOW_HASKELL__ >= 610
+import Control.OldException
+#else
+import Control.Exception
+#endif
+import Control.Monad
+
+runTests :: String -> [String] -> IO Bool
+runTests cwd tests = do
+     fails <- run tests
+     if  "bugs" `isInfixOf` cwd
+         then if (length tests /= length fails)
+                 then do putStrLn $ "Some bug tests passed:"
+                         mapM_ putStrLn (tests \\ fails)
+                         return False
+                 else do putStrLn "All bug tests OK"
+                         return True
+         else if fails /= []
+                 then do putStrLn "Some tests failed:"
+                         mapM_ putStrLn fails
+                         return False
+                 else do putStrLn "All tests OK"
+                         return True
+
+run :: [String] -> IO [String]
+run tests= do
+    cwd <-  getCurrentDirectory
+    path <- getEnv "PATH"
+    env <- getEnvironment
+    darcs_path <- get_darcs_path
+    let myenv = [("HOME",cwd)
+                ,("DARCS_TESTING_HOME",cwd)
+                ,("PWD",cwd)
+                ,("EMAIL","tester")
+                ,("DARCSEMAIL","tester")
+                ,("PATH",(darcs_path++":"++path))
+                ,("DARCS_DONT_COLOR","1")
+                ,("DARCS_DONT_ESCAPE_ANYTHING","1")]
+    bash <- find_bash
+    let shell = takeWhile (/= '\n') bash
+    putStrLn $ "Using bash shell in '"++shell++"'"
+    set_prefs
+    run_helper shell tests []  (set_env myenv env)
+  where get_darcs_path = do
+           env <- getEnvironment
+           cwd <-  getCurrentDirectory
+           case lookup "DARCS" env of
+                Nothing -> return (cwd ++ "/..")
+                Just d  -> return $ takeDirectory d
+        set_prefs = do
+            finally (catch (appendFile ".darcs/defaults" "ALL --ignore-times")
+                           (\e -> fail $ "Unable to set preferences: "
+                                         ++ show e))
+                    (createDirectoryIfMissing  False ".darcs")
+run_helper :: String -> [String] -> [String] ->
+                  [(String,String)] -> IO [String]
+run_helper _ [] fails _ = return fails
+run_helper shell (test:ts) fails env = do
+    putStr $ "Running " ++ test ++ " ..." ++ (replicate (36 - (length test)) ' ')
+    (output,success) <- backtick shell test env
+    if success then do putStrLn " passed."
+                       cleanup_dirs
+                       run_helper shell ts fails env
+               else do putStrLn " failed."
+                       putStrLn $ "Probable reason :" ++ output
+                       cleanup_dirs
+                       run_helper shell ts (fails++[test]) env
+  where cleanup_dirs :: IO ()
+        cleanup_dirs =
+          do dirfiles <- getDirectoryContents (fromJust $ lookup "PWD" env)
+             let tempfiles = (filter ("temp" `isPrefixOf`) dirfiles) ++
+                             (filter ("tmp" `isPrefixOf`) dirfiles)
+             mapM_ (\x-> 
+                  setPermissions x (Permissions 
+                                   {readable = True
+                                   ,writable = True
+                                   ,executable = False
+                                   ,searchable = True}
+                                   )
+                 ) tempfiles
+
+backtick :: String -> String -> [(String, String)]-> IO (String,Bool)
+backtick cmd args env = do
+   (exitcode,res) <- backtick_helper cmd args env
+   case exitcode of
+        ExitSuccess -> return (res, True)
+        ExitFailure code -> return (res, False)
+
+backtick_helper :: String -> String -> [(String,String)] ->
+                                      IO (ExitCode, String)
+backtick_helper cmd args env = process_wrapper (runInteractiveProcess
+                                                   cmd [args] Nothing
+                                                   (Just env)
+                                               ) ""
+
+find_bash =
+   do sh <- findExecutable "bash"
+      case sh of
+          Just p -> return p
+          Nothing -> error "Could not find bash in PATH"
+
+-- | Run a process with a list of arguments and return anything from
+-- /stderr/ or /stdout/
+process_wrapper :: IO (Handle, Handle, Handle, ProcessHandle) ->
+                   String -> IO (ExitCode, String)
+process_wrapper f _ = do
+       (_,o,e,pid) <- f
+       hSetBuffering o LineBuffering
+       hSetBuffering e LineBuffering
+       ch <- newChan
+       -- WARNING: beware of hokeyness ahead!
+       let readWrite i = do x <- hGetLine i
+                            writeChan ch $ Just x
+                            readWrite i
+                         `catch` \_ -> writeChan ch Nothing
+           readEO = do x <- readChan ch
+                       case x of
+                         Just l -> do y <- readEO
+                                      return $ l:y
+                         Nothing -> readEO'
+           readEO' = do x <- readChan ch
+                        case x of
+                          Just l -> do y <- readEO'
+                                       return $ l:y
+                          Nothing -> return []
+       forkIO $ readWrite o
+       forkIO $ readWrite e
+       outerr <- readEO
+       ec <- waitForProcessNonBlocking pid
+       threadDelay 1000
+       case ec of
+         ExitFailure 127 -> fail $ "timeout running command\n\n"
+                                   ++unlines outerr
+         _ -> return (ec, unlines outerr)
+
+--
+-- waitForProcess uses a very hokey heuristic to try to avoid burning too
+-- much CPU time in a busy wait, while also not adding too much extra
+-- latency.
+
+waitForProcessNonBlocking :: ProcessHandle -> IO ExitCode
+waitForProcessNonBlocking = if rtsSupportsBoundThreads
+                            then waitForProcess
+                            else wfp 0
+    where wfp n pid = do mec <- getProcessExitCode pid
+                         case mec of
+                           Just ec -> return ec
+                           Nothing -> do threadDelay n
+                                         wfp (min 100000 (n+1+n`div`4)) pid
+
+
+
+set_env :: [(String,String)] -> [(String,String)] -> [(String, String)]
+set_env es env = nubBy (\(x,_) (y,_) -> x == y) (es ++ env)
diff --git a/darcs.cabal b/darcs.cabal
--- a/darcs.cabal
+++ b/darcs.cabal
@@ -1,5 +1,5 @@
 Name:           darcs
-version:        2.1.2.1
+version:        2.1.2.2
 License:        GPL
 License-file:   COPYING
 Author:         David Roundy <droundy@darcs.net>, <darcs-users@darcs.net>
@@ -62,6 +62,7 @@
   release/distributed-version, release/distributed-context
 
   -- testsuite
+  Distribution/ShellHarness.hs
   tests/repos/*.tgz tests/repos/README
   tests/*.sh
   tests/network/*.sh