summaryrefslogtreecommitdiff
path: root/git-recover-repository.hs
blob: d2249a433b8c39b2265cb22ccd678ca79a267ffd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
{- git-recover-repository program
 -
 - Copyright 2013 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

import System.Environment
import System.Log.Logger
import System.Log.Formatter
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple
import qualified Data.Set as S

import Common
import qualified Git
import qualified Git.CurrentRepo
import qualified Git.Fsck
import qualified Git.RecoverRepository
import qualified Git.Config
import qualified Git.Branch

header :: String
header = "Usage: git-recover-repository"

usage :: a
usage = error $ "bad parameters\n\n" ++ header

parseArgs :: IO Bool
parseArgs = do
	args <- getArgs
	return $ or $ map parse args
  where
	parse "--force" = True
	parse _ = usage

enableDebugOutput :: IO ()
enableDebugOutput = do
	s <- setFormatter
		<$> streamHandler stderr NOTICE
		<*> pure (simpleLogFormatter "$msg")
	updateGlobalLogger rootLoggerName (setLevel DEBUG . setHandlers [s])

main :: IO ()
main = do
	enableDebugOutput
	forced <- parseArgs
	
	g <- Git.Config.read =<< Git.CurrentRepo.get
	putStrLn "Running git fsck ..."
	fsckresult <- Git.Fsck.findBroken False g
	missing <- Git.RecoverRepository.cleanCorruptObjects fsckresult g
	stillmissing <- Git.RecoverRepository.retrieveMissingObjects missing g
	if S.null stillmissing
		then putStr $ unlines
			[ "Successfully recovered repository!"
			, "You should run \"git fsck\" to make sure, but it looks like"
			, "everything was recovered ok."
			]
		else do
			putStrLn $ unwords
				[ show (S.size stillmissing)
				, "missing objects could not be recovered!"
				]
			if forced
				then do
					(remotebranches, goodcommits) <- Git.RecoverRepository.removeTrackingBranches stillmissing Git.RecoverRepository.emptyGoodCommits g
					unless (null remotebranches) $
						putStrLn $ unwords
							[ "removed"
							, show (length remotebranches)
							, "remote tracking branches that referred to missing objects"
							]
					(resetbranches, deletedbranches, _) <- Git.RecoverRepository.resetLocalBranches stillmissing goodcommits g
					printList (map show resetbranches)
						"Reset these local branches to old versions before the missing objects were committed:"
					printList (map show deletedbranches)
						"Deleted these local branches, which could not be recovered due to missing objects:"
					deindexedfiles <- Git.RecoverRepository.rewriteIndex stillmissing g
					printList deindexedfiles
						"Removed these missing files from the index. You should look at what files are present in your working tree and git add them back to the index when appropriate."
					unless (Git.repoIsLocalBare g) $ do
						mcurr <- Git.Branch.currentUnsafe g
						case mcurr of
							Nothing -> return ()
							Just curr -> when (any (== curr) (resetbranches ++ deletedbranches)) $ do
								putStrLn $ unwords
									[ "You currently have"
									, show curr
									, "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!"
									]
				else if Git.repoIsLocalBare g
					then do
						putStrLn "If you have a clone of this bare repository, you should add it as a remote of this repository, and re-run git-recover-repository."
						putStrLn "If there are no clones of this repository, you can instead run git-recover-repository with the --force parameter to force recovery to a possibly usable state."
					else putStrLn "To force a recovery to a usable state, run this command again with the --force parameter."

printList :: [String] -> String -> IO ()
printList items header
	| null items = return ()
	| otherwise = do
		putStrLn header
		putStr $ unlines $ map (\i -> "\t" ++ i) truncateditems
  where
  	numitems = length items
	truncateditems
		| numitems > 10 = take 10 items ++ ["(and " ++ show (numitems - 10) ++ " more)"]
		| otherwise = items