diff --git a/Git/Command.hs b/Git/Command.hs --- a/Git/Command.hs +++ b/Git/Command.hs @@ -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 = diff --git a/Git/Fsck.hs b/Git/Fsck.hs --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -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" diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -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) diff --git a/Git/Objects.hs b/Git/Objects.hs --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -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 diff --git a/Git/Repair.hs b/Git/Repair.hs --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -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) diff --git a/Utility/Batch.hs b/Utility/Batch.hs --- a/Utility/Batch.hs +++ b/Utility/Batch.hs @@ -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) -> diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs --- a/Utility/CoProcess.hs +++ b/Utility/CoProcess.hs @@ -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 diff --git a/Utility/Directory.hs b/Utility/Directory.hs --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -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. -} diff --git a/Utility/Metered.hs b/Utility/Metered.hs --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -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 diff --git a/Utility/Path.hs b/Utility/Path.hs --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -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 diff --git a/Utility/Process.hs b/Utility/Process.hs --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -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. diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -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) diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -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 Wed, 15 Jan 2014 16:53:30 -0400 + git-repair (1.20131213) unstable; urgency=low * Improve repair of index files in some situations. diff --git a/git-repair.cabal b/git-repair.cabal --- a/git-repair.cabal +++ b/git-repair.cabal @@ -1,5 +1,5 @@ Name: git-repair -Version: 1.20131213 +Version: 1.20140115 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess