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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
{- git-annex assistant repository repair
-
- Copyright 2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Assistant.Repair where
import Assistant.Common
import Command.Repair (repairAnnexBranch, trackingOrSyncBranch)
import Git.Fsck (FsckResults, foundBroken)
import Git.Repair (runRepairOf)
import qualified Git
import qualified Remote
import qualified Types.Remote as Remote
import Logs.FsckResults
import Annex.UUID
import Utility.Batch
import Annex.Path
import Assistant.Sync
import Assistant.Alert
import Assistant.DaemonStatus
import Assistant.Types.UrlRenderer
#ifdef WITH_WEBAPP
import Assistant.WebApp.Types
import qualified Data.Text as T
#endif
import qualified Utility.Lsof as Lsof
import Utility.ThreadScheduler
import Control.Concurrent.Async
{- When the FsckResults require a repair, tries to do a non-destructive
- repair. If that fails, pops up an alert. -}
repairWhenNecessary :: UrlRenderer -> UUID -> Maybe Remote -> FsckResults -> Assistant Bool
repairWhenNecessary urlrenderer u mrmt fsckresults
| foundBroken fsckresults = do
liftAnnex $ writeFsckResults u fsckresults
repodesc <- liftAnnex $ Remote.prettyUUID u
ok <- alertWhile (repairingAlert repodesc)
(runRepair u mrmt False)
#ifdef WITH_WEBAPP
unless ok $ do
button <- mkAlertButton True (T.pack "Click Here") urlrenderer $
RepairRepositoryR u
void $ addAlert $ brokenRepositoryAlert [button]
#endif
return ok
| otherwise = return False
runRepair :: UUID -> Maybe Remote -> Bool -> Assistant Bool
runRepair u mrmt destructiverepair = do
fsckresults <- liftAnnex $ readFsckResults u
myu <- liftAnnex getUUID
ok <- if u == myu
then localrepair fsckresults
else remoterepair fsckresults
liftAnnex $ clearFsckResults u
debug [ "Repaired", show u, show ok ]
return ok
where
localrepair fsckresults = do
-- Stop the watcher from running while running repairs.
changeSyncable Nothing False
-- This intentionally runs the repair inside the Annex
-- monad, which is not strictly necessary, but keeps
-- other threads that might be trying to use the Annex
-- from running until it completes.
ok <- liftAnnex $ repair fsckresults Nothing
-- Run a background fast fsck if a destructive repair had
-- to be done, to ensure that the git-annex branch
-- reflects the current state of the repo.
when destructiverepair $
backgroundfsck [ Param "--fast" ]
-- Start the watcher running again. This also triggers it to
-- do a startup scan, which is especially important if the
-- git repo repair removed files from the index file. Those
-- files will be seen as new, and re-added to the repository.
when (ok || destructiverepair) $
changeSyncable Nothing True
return ok
remoterepair fsckresults = case Remote.repairRepo =<< mrmt of
Nothing -> return False
Just mkrepair -> do
thisrepopath <- liftIO . absPath
=<< liftAnnex (fromRepo Git.repoPath)
a <- liftAnnex $ mkrepair $
repair fsckresults (Just thisrepopath)
liftIO $ catchBoolIO a
repair fsckresults referencerepo = do
(ok, modifiedbranches) <- inRepo $
runRepairOf fsckresults trackingOrSyncBranch destructiverepair referencerepo
when destructiverepair $
repairAnnexBranch modifiedbranches
return ok
backgroundfsck params = liftIO $ void $ async $ do
program <- programPath
batchCommand program (Param "fsck" : params)
{- Detect when a git lock file exists and has no git process currently
- writing to it. This strongly suggests it is a stale lock file.
-
- However, this could be on a network filesystem. Which is not very safe
- anyway (the assistant relies on being able to check when files have
- no writers to know when to commit them). Also, a few lock-file-ish
- things used by git are not kept open, particularly MERGE_HEAD.
-
- So, just in case, when the lock file appears stale, we delay for one
- minute, and check its size. If the size changed, delay for another
- minute, and so on. This will at work to detect when another machine
- is writing out a new index file, since git does so by writing the
- new content to index.lock.
-
- Returns true if locks were cleaned up.
-}
repairStaleGitLocks :: Git.Repo -> Assistant Bool
repairStaleGitLocks r = do
lockfiles <- liftIO $ filter islock <$> findgitfiles r
repairStaleLocks lockfiles
return $ not $ null lockfiles
where
findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) True . Git.localGitDir
islock f
| "gc.pid" `isInfixOf` f = False
| ".lock" `isSuffixOf` f = True
| takeFileName f == "MERGE_HEAD" = True
| otherwise = False
repairStaleLocks :: [FilePath] -> Assistant ()
repairStaleLocks lockfiles = go =<< getsizes
where
getsize lf = catchMaybeIO $ (\s -> (lf, s)) <$> getFileSize lf
getsizes = liftIO $ catMaybes <$> mapM getsize lockfiles
go [] = return ()
go l = ifM (liftIO $ null <$> Lsof.query ("--" : map fst l))
( do
waitforit "to check stale git lock file"
l' <- getsizes
if l' == l
then liftIO $ mapM_ nukeFile (map fst l)
else go l'
, do
waitforit "for git lock file writer"
go =<< getsizes
)
waitforit why = do
notice ["Waiting for 60 seconds", why]
liftIO $ threadDelaySeconds $ Seconds 60
|
