blob: adfd702de7928844d24c390486dc112a645775ad (
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
|
{- 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 (when)
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
import Locations
command :: [Command]
command = [repoCommand "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
next $ 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 next $ return True
else stop
{- 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
g <- Annex.gitRepo
present <- inAnnex key
-- Since we're checking that a key's file is present, throw
-- in a permission fixup here too.
when present $ liftIO $ do
let f = gitAnnexLocation g key
preventWrite f
preventWrite (parentDir f)
u <- getUUID g
uuids <- liftIO $ keyLocations g key
case (present, u `elem` uuids) of
(True, False) -> do
fix u ValuePresent
-- There is no data loss, so do not fail.
return True
(False, True) -> do
fix 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 u s = do
showNote "fixing location log"
logStatusFor u key s
|
