blob: 76d0e38b4b060f666a9dd5de35727117a63aae30 (
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
|
{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Fsck where
import Control.Monad.State (liftIO)
import Command
import qualified Backend
import qualified Annex
import UUID
import Types
import Messages
import Utility
import Content
import LocationLog
command :: [Command]
command = [Command "fsck" (paramOptional $ paramRepeating paramPath) seek
"check for problems"]
seek :: [CommandSeek]
seek = [withAttrFilesInGit "annex.numcopies" start]
start :: CommandStartAttrFile
start (file, attr) = notBareRepo $ isAnnexed file $ \(key, backend) -> do
showStart "fsck" file
return $ Just $ perform key file backend numcopies
where
numcopies = readMaybe attr :: Maybe Int
perform :: Key -> FilePath -> Backend Annex -> Maybe Int -> CommandPerform
perform key file backend numcopies = do
-- the location log is checked first, so that if it has bad data
-- that gets corrected
locationlogok <- verifyLocationLog key file
backendok <- Backend.fsckKey backend key (Just file) numcopies
if locationlogok && backendok
then return $ Just $ return True
else return Nothing
{- Checks that the location log reflects the current status of the key,
in this repository only. -}
verifyLocationLog :: Key -> FilePath -> Annex Bool
verifyLocationLog key file = do
present <- inAnnex key
g <- Annex.gitRepo
u <- getUUID g
uuids <- liftIO $ keyLocations g key
case (present, u `elem` uuids) of
(True, False) -> do
fix g u ValuePresent
-- There is no data loss, so do not fail.
return True
(False, True) -> do
fix g u ValueMissing
warning $
"** Based on the location log, " ++ file
++ "\n** was expected to be present, " ++
"but its content is missing."
return False
_ -> return True
where
fix g u s = do
showNote "fixing location log"
_ <- liftIO $ logChange g key u s
return ()
|
