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
|
{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Fsck where
import Annex.Common
import Command
import qualified Remote
import qualified Types.Backend
import qualified Types.Key
import UUID
import Annex.Content
import LocationLog
import Trust
import Utility.DataUnits
import Utility.FileMode
import Config
command :: [Command]
command = [repoCommand "fsck" paramPaths seek "check for problems"]
seek :: [CommandSeek]
seek = [withNumCopies start]
start :: FilePath -> Maybe Int -> CommandStart
start file numcopies = notBareRepo $ isAnnexed file $ \(key, backend) -> do
showStart "fsck" file
next $ perform key file backend numcopies
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 <- 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 <- 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 <- keyLocations key
case (present, u `elem` uuids) of
(True, False) -> do
fix g u InfoPresent
-- There is no data loss, so do not fail.
return True
(False, True) -> do
fix g u InfoMissing
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"
logChange g key u s
{- Checks a key for problems. -}
fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool
fsckKey backend key file numcopies = do
size_ok <- checkKeySize key
copies_ok <- checkKeyNumCopies key file numcopies
backend_ok <- (Types.Backend.fsckKey backend) key
return $ size_ok && copies_ok && backend_ok
{- The size of the data for a key is checked against the size encoded in
- the key's metadata, if available. -}
checkKeySize :: Key -> Annex Bool
checkKeySize key = do
g <- gitRepo
let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file
case (present, Types.Key.keySize key) of
(_, Nothing) -> return True
(False, _) -> return True
(True, Just size) -> do
stat <- liftIO $ getFileStatus file
let size' = fromIntegral (fileSize stat)
if size == size'
then return True
else do
dest <- moveBad key
warning $ "Bad file size (" ++
compareSizes storageUnits True size size' ++
"); moved to " ++ dest
return False
checkKeyNumCopies :: Key -> Maybe FilePath -> Maybe Int -> Annex Bool
checkKeyNumCopies key file numcopies = do
needed <- getNumCopies numcopies
(untrustedlocations, safelocations) <- trustPartition UnTrusted =<< keyLocations key
let present = length safelocations
if present < needed
then do
ppuuids <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations
warning $ missingNote (filename file key) present needed ppuuids
return False
else return True
where
filename Nothing k = show k
filename (Just f) _ = f
missingNote :: String -> Int -> Int -> String -> String
missingNote file 0 _ [] =
"** No known copies exist of " ++ file
missingNote file 0 _ untrusted =
"Only these untrusted locations may have copies of " ++ file ++
"\n" ++ untrusted ++
"Back it up to trusted locations with git-annex copy."
missingNote file present needed [] =
"Only " ++ show present ++ " of " ++ show needed ++
" trustworthy copies exist of " ++ file ++
"\nBack it up with git-annex copy."
missingNote file present needed untrusted =
missingNote file present needed [] ++
"\nThe following untrusted locations may also have copies: " ++
"\n" ++ untrusted
|
