git-repair 1.20131213 → 1.20140115

raw patch · 14 files changed

+88/−37 lines, 14 files

Files

• Git/Command.hs +6/−1
• Git/Fsck.hs +15/−5
• Git/LsFiles.hs +3/−2
• Git/Objects.hs +1/−1
• Git/Repair.hs +1/−1
• Utility/Batch.hs +4/−0
• Utility/CoProcess.hs +7/−6
• Utility/Directory.hs +20/−8
• Utility/Metered.hs +1/−1
• Utility/Path.hs +3/−3
• Utility/Process.hs +5/−7
• Utility/Tmp.hs +12/−1
• debian/changelog +9/−0
• git-repair.cabal +1/−1

@@ -128,9 +128,14 @@  {- Runs a git command as a coprocess. -} gitCoProcessStart :: Bool -> [CommandParam] -> Repo -> IO CoProcess.CoProcessHandle-gitCoProcessStart restartable params repo = CoProcess.start restartable "git"+gitCoProcessStart restartable params repo = CoProcess.start numrestarts "git" 	(toCommand $ gitCommandLine params repo) 	(gitEnv repo)+  where+  	{- If a long-running git command like cat-file --batch+	 - crashes, it will likely start up again ok. If it keeps crashing+	 - 10 times, something is badly wrong. -}+	numrestarts = if restartable then 10 else 0  gitCreateProcess :: [CommandParam] -> Repo -> CreateProcess gitCreateProcess params repo =

@@ -20,6 +20,7 @@ import Git.Command import Git.Sha import Utility.Batch+import qualified Git.BuildVersion  import qualified Data.Set as S @@ -75,11 +76,20 @@ 		] r  findShas :: String -> [Sha]-findShas = catMaybes . map extractSha . concat . map words . lines+findShas = catMaybes . map extractSha . concat . map words . filter wanted . lines+  where+	wanted l+		| supportsNoDangling = True+		| otherwise = not ("dangling " `isPrefixOf` l)  fsckParams :: Repo -> [CommandParam]-fsckParams = gitCommandLine $-	[ Param "fsck"-	, Param "--no-dangling"-	, Param "--no-reflogs"+fsckParams = gitCommandLine $ map Param $ catMaybes+	[ Just "fsck"+	, if supportsNoDangling+		then Just "--no-dangling"+		else Nothing+	, Just "--no-reflogs" 	]++supportsNoDangling :: Bool+supportsNoDangling = not $ Git.BuildVersion.older "1.7.10"

@@ -66,11 +66,12 @@   where 	params = [Params "ls-files --modified -z --"] ++ map File l -{- Files that have been modified or are not checked into git. -}+{- Files that have been modified or are not checked into git (and are not+ - ignored). -} modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) modifiedOthers l repo = pipeNullSplit params repo   where-	params = [Params "ls-files --modified --others -z --"] ++ map File l+	params = [Params "ls-files --modified --others --exclude-standard -z --"] ++ map File l  {- Returns a list of all files that are staged for commit. -} staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)

@@ -27,7 +27,7 @@ listLooseObjectShas :: Repo -> IO [Sha] listLooseObjectShas r = catchDefaultIO [] $ 	mapMaybe (extractSha . concat . reverse . take 2 . reverse . splitDirectories)-		<$> dirContentsRecursiveSkipping (== "pack") (objectsDir r)+		<$> dirContentsRecursiveSkipping (== "pack") True (objectsDir r)  looseObjectFile :: Repo -> Sha -> FilePath looseObjectFile r sha = objectsDir r </> prefix </> rest

@@ -231,7 +231,7 @@ 		nukeFile f   where 	makeref (sha, ref) = do-		let dest = localGitDir r ++ show ref+		let dest = localGitDir r </> show ref 		createDirectoryIfMissing True (parentDir dest) 		unlessM (doesFileExist dest) $ 			writeFile dest (show sha)

@@ -52,7 +52,11 @@ #ifndef mingw32_HOST_OS 	nicers <- filterM (inPath . fst) 		[ ("nice", [])+#ifndef __ANDROID__+		-- Android's ionice does not allow specifying a command,+		-- so don't use it. 		, ("ionice", ["-c3"])+#endif 		, ("nocache", []) 		] 	return $ \(command, params) ->

@@ -30,15 +30,15 @@ 	}  data CoProcessSpec = CoProcessSpec-	{ coProcessRestartable :: Bool+	{ coProcessNumRestarts :: Int 	, coProcessCmd :: FilePath 	, coProcessParams :: [String] 	, coProcessEnv :: Maybe [(String, String)] 	} -start :: Bool -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle-start restartable cmd params env = do-	s <- start' $ CoProcessSpec restartable cmd params env+start :: Int -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle+start numrestarts cmd params env = do+	s <- start' $ CoProcessSpec numrestarts cmd params env 	newMVar s  start' :: CoProcessSpec -> IO CoProcessState@@ -66,7 +66,7 @@ 				return   where   	restartable s a cont-		| coProcessRestartable (coProcessSpec s) =+		| coProcessNumRestarts (coProcessSpec s) > 0 = 			maybe restart cont =<< catchMaybeIO a 		| otherwise = cont =<< a 	restart = do@@ -75,7 +75,8 @@ 			hClose $ coProcessTo s 			hClose $ coProcessFrom s 		void $ waitForProcess $ coProcessPid s-		s' <- start' (coProcessSpec s)+		s' <- start' $ (coProcessSpec s)+			{ coProcessNumRestarts = coProcessNumRestarts (coProcessSpec s) - 1 } 		putMVar ch s' 		query ch send receive 

@@ -35,14 +35,18 @@ dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d  {- Gets files in a directory, and then its subdirectories, recursively,- - and lazily. If the directory does not exist, no exception is thrown,+ - and lazily.+ -+ - Does not follow symlinks to other subdirectories.+ -+ - When the directory does not exist, no exception is thrown,  - instead, [] is returned. -} dirContentsRecursive :: FilePath -> IO [FilePath]-dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) topdir+dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) True topdir  {- Skips directories whose basenames match the skipdir. -}-dirContentsRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]-dirContentsRecursiveSkipping skipdir topdir = go [topdir]+dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]+dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]   where   	go [] = return [] 	go (dir:dirs)@@ -56,10 +60,18 @@ 	collect files dirs' (entry:entries) 		| dirCruft entry = collect files dirs' entries 		| otherwise = do-			ifM (doesDirectoryExist entry)-				( collect files (entry:dirs') entries-				, collect (entry:files) dirs' entries-				)			+			let skip = collect (entry:files) dirs' entries+			let recurse = collect files (entry:dirs') entries+			ms <- catchMaybeIO $ getSymbolicLinkStatus entry+			case ms of+				(Just s) +					| isDirectory s -> recurse+					| isSymbolicLink s && followsubdirsymlinks ->+						ifM (doesDirectoryExist entry)+							( recurse+							, skip+							)+				_ -> skip  {- Moves one filename to another.  - First tries a rename, but falls back to moving across devices if needed. -}

@@ -25,7 +25,7 @@  {- Total number of bytes processed so far. -} newtype BytesProcessed = BytesProcessed Integer-	deriving (Eq, Ord)+	deriving (Eq, Ord, Show)  class AsBytesProcessed a where 	toBytesProcessed :: a -> BytesProcessed

@@ -242,13 +242,13 @@  - was provided by a third party and is not to be trusted, returns the closest  - sane FilePath.  -- - All spaces and punctuation are replaced with '_', except for '.'- - "../" will thus turn into ".._", which is safe.+ - All spaces and punctuation and other wacky stuff are replaced+ - with '_', except for '.' "../" will thus turn into ".._", which is safe.  -} sanitizeFilePath :: String -> FilePath sanitizeFilePath = map sanitize   where   	sanitize c 		| c == '.' = c-		| isSpace c || isPunctuation c || c == '/' = '_'+		| isSpace c || isPunctuation c || isSymbol c || isControl c || c == '/' = '_' 		| otherwise = c

@@ -26,12 +26,12 @@ 	withHandle, 	withBothHandles, 	withQuietOutput,-	withNullHandle, 	createProcess, 	startInteractiveProcess, 	stdinHandle, 	stdoutHandle, 	stderrHandle,+	devNull, ) where  import qualified System.Process@@ -280,20 +280,18 @@ 	:: CreateProcessRunner 	-> CreateProcess 	-> IO ()-withQuietOutput creator p = withNullHandle $ \nullh -> do+withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do 	let p' = p 		{ std_out = UseHandle nullh 		, std_err = UseHandle nullh 		} 	creator p' $ const $ return () -withNullHandle :: (Handle -> IO a) -> IO a-withNullHandle = withFile devnull WriteMode-  where+devNull :: FilePath #ifndef mingw32_HOST_OS-	devnull = "/dev/null"+devNull = "/dev/null" #else-	devnull = "NUL"+devNull = "NUL" #endif  {- Extract a desired handle from createProcess's tuple.

@@ -5,6 +5,8 @@  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Utility.Tmp where  import Control.Exception (bracket)@@ -61,8 +63,17 @@ withTmpDirIn :: FilePath -> Template -> (FilePath -> IO a) -> IO a withTmpDirIn tmpdir template = bracket create remove   where-	remove d = whenM (doesDirectoryExist d) $+	remove d = whenM (doesDirectoryExist d) $ 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 d+		return ()+#else 		removeDirectoryRecursive d+#endif 	create = do 		createDirectoryIfMissing True tmpdir 		makenewdir (tmpdir </> template) (0 :: Int)

@@ -1,3 +1,12 @@+git-repair (1.20140115) unstable; urgency=medium++  * Support old git versions from before git fsck --no-dangling was+    implemented.+  * Fix bug in packed refs file exploding code that caused a .gitrefs+    directory to be created instead of .git/refs++ -- Joey Hess <joeyh@debian.org>  Wed, 15 Jan 2014 16:53:30 -0400+ git-repair (1.20131213) unstable; urgency=low    * Improve repair of index files in some situations.

@@ -1,5 +1,5 @@ Name: git-repair-Version: 1.20131213+Version: 1.20140115 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess <joey@kitenet.net>