git-repair (1.20131122) unstable; urgency=low

  * Added test mode, which can be used to randomly corrupt test
    repositories, in reproducible ways, which allows easy
    corruption-driven-development.
  * Improve repair code in the case where the index file is corrupt,
    and this hides other problems.
  * Write a dummy .git/HEAD if the file is missing or corrupt, as
    git otherwise will not treat the repository as a git repo.
  * Improve fsck code to find badly corrupted objects that crash git fsck
    before it can complain about them.
  * Fixed crashes on bad file encodings.
  * Can now run 10000 tests (git-repair --test -n 10000 --force)
    with 0 failures.

# imported from the archive

1 files changed, 138 insertions, 0 deletions

diff --git a/Git/Command.hs b/Git/Command.hs
new file mode 100644
index 0000000..adcc53b
--- /dev/null
+++ b/Git/Command.hs
@@ -0,0 +1,138 @@
+{- running git commands
+ -
+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Git.Command where
+
+import System.Process (std_out, env)
+
+import Common
+import Git
+import Git.Types
+import qualified Utility.CoProcess as CoProcess
+#ifdef mingw32_HOST_OS
+import Git.FilePath
+#endif
+
+{- Constructs a git command line operating on the specified repo. -}
+gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
+gitCommandLine params r@(Repo { location = l@(Local _ _ ) }) =
+	setdir : settree ++ gitGlobalOpts r ++ params
+  where
+	setdir = Param $ "--git-dir=" ++ gitpath (gitdir l)
+	settree = case worktree l of
+		Nothing -> []
+		Just t -> [Param $ "--work-tree=" ++ gitpath t]
+#ifdef mingw32_HOST_OS
+	-- despite running on windows, msysgit wants a unix-formatted path
+	gitpath s
+		| isAbsolute s = "/" ++ dropDrive (toInternalGitPath s)
+		| otherwise = s
+#else
+	gitpath = id
+#endif
+gitCommandLine _ repo = assertLocal repo $ error "internal"
+
+{- Runs git in the specified repo. -}
+runBool :: [CommandParam] -> Repo -> IO Bool
+runBool params repo = assertLocal repo $
+	boolSystemEnv "git"
+		(gitCommandLine params repo)
+		(gitEnv repo)
+
+{- Runs git in the specified repo, throwing an error if it fails. -}
+run :: [CommandParam] -> Repo -> IO ()
+run params repo = assertLocal repo $
+	unlessM (runBool params repo) $
+		error $ "git " ++ show params ++ " failed"
+
+{- Runs git and forces it to be quiet, throwing an error if it fails. -}
+runQuiet :: [CommandParam] -> Repo -> IO ()
+runQuiet params repo = withQuietOutput createProcessSuccess $
+	(proc "git" $ toCommand $ gitCommandLine (params) repo)
+		{ env = gitEnv repo }
+
+{- Runs a git command and returns its output, lazily.
+ -
+ - Also returns an action that should be used when the output is all
+ - read (or no more is needed), that will wait on the command, and
+ - return True if it succeeded. Failure to wait will result in zombies.
+ -}
+pipeReadLazy :: [CommandParam] -> Repo -> IO (String, IO Bool)
+pipeReadLazy params repo = assertLocal repo $ do
+	(_, Just h, _, pid) <- createProcess p { std_out = CreatePipe }
+	fileEncoding h
+	c <- hGetContents h
+	return (c, checkSuccessProcess pid)
+  where
+	p  = gitCreateProcess params repo
+
+{- Runs a git command, and returns its output, strictly.
+ -
+ - Nonzero exit status is ignored.
+ -}
+pipeReadStrict :: [CommandParam] -> Repo -> IO String
+pipeReadStrict params repo = assertLocal repo $
+	withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do
+		fileEncoding h
+		output <- hGetContentsStrict h
+		hClose h
+		return output
+  where
+	p  = gitCreateProcess params repo
+
+{- Runs a git command, feeding it an input, and returning its output,
+ - which is expected to be fairly small, since it's all read into memory
+ - strictly. -}
+pipeWriteRead :: [CommandParam] -> Maybe (Handle -> IO ()) -> Repo -> IO String
+pipeWriteRead params writer repo = assertLocal repo $
+	writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo) 
+		(gitEnv repo) writer (Just adjusthandle)
+  where
+  	adjusthandle h = do
+		fileEncoding h
+		hSetNewlineMode h noNewlineTranslation
+
+{- Runs a git command, feeding it input on a handle with an action. -}
+pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()
+pipeWrite params repo = withHandle StdinHandle createProcessSuccess $
+	gitCreateProcess params repo
+
+{- Reads null terminated output of a git command (as enabled by the -z 
+ - parameter), and splits it. -}
+pipeNullSplit :: [CommandParam] -> Repo -> IO ([String], IO Bool)
+pipeNullSplit params repo = do
+	(s, cleanup) <- pipeReadLazy params repo
+	return (filter (not . null) $ split sep s, cleanup)
+  where
+	sep = "\0"
+
+pipeNullSplitStrict :: [CommandParam] -> Repo -> IO [String]
+pipeNullSplitStrict params repo = do
+	s <- pipeReadStrict params repo
+	return $ filter (not . null) $ split sep s
+  where
+	sep = "\0"
+
+pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [String]
+pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo
+
+{- Doesn't run the cleanup action. A zombie results. -}
+leaveZombie :: (a, IO Bool) -> a
+leaveZombie = fst
+
+{- Runs a git command as a coprocess. -}
+gitCoProcessStart :: Bool -> [CommandParam] -> Repo -> IO CoProcess.CoProcessHandle
+gitCoProcessStart restartable params repo = CoProcess.start restartable "git"
+	(toCommand $ gitCommandLine params repo)
+	(gitEnv repo)
+
+gitCreateProcess :: [CommandParam] -> Repo -> CreateProcess
+gitCreateProcess params repo =
+	(proc "git" $ toCommand $ gitCommandLine params repo)
+			{ env = gitEnv repo }