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
160
161
162
163
164
165
166
167
168
169
170
171
|
{- git-annex numcopies configuration and checking
-
- Copyright 2014-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.NumCopies (
module Types.NumCopies,
module Logs.NumCopies,
getFileNumCopies,
getGlobalFileNumCopies,
getNumCopies,
deprecatedNumCopies,
defaultNumCopies,
numCopiesCheck,
numCopiesCheck',
verifyEnoughCopies,
knownCopies,
) where
import Common.Annex
import qualified Annex
import Types.NumCopies
import Logs.NumCopies
import Logs.Trust
import Annex.CheckAttr
import qualified Remote
import Annex.UUID
import Annex.Content
defaultNumCopies :: NumCopies
defaultNumCopies = NumCopies 1
fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies
fromSources = fromMaybe defaultNumCopies <$$> getM id
{- The git config annex.numcopies is deprecated. -}
deprecatedNumCopies :: Annex (Maybe NumCopies)
deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig
{- Value forced on the command line by --numcopies. -}
getForcedNumCopies :: Annex (Maybe NumCopies)
getForcedNumCopies = Annex.getState Annex.forcenumcopies
{- Numcopies value from any of the non-.gitattributes configuration
- sources. -}
getNumCopies :: Annex NumCopies
getNumCopies = fromSources
[ getForcedNumCopies
, getGlobalNumCopies
, deprecatedNumCopies
]
{- Numcopies value for a file, from any configuration source, including the
- deprecated git config. -}
getFileNumCopies :: FilePath -> Annex NumCopies
getFileNumCopies f = fromSources
[ getForcedNumCopies
, getFileNumCopies' f
, deprecatedNumCopies
]
{- This is the globally visible numcopies value for a file. So it does
- not include local configuration in the git config or command line
- options. -}
getGlobalFileNumCopies :: FilePath -> Annex NumCopies
getGlobalFileNumCopies f = fromSources
[ getFileNumCopies' f
]
getFileNumCopies' :: FilePath -> Annex (Maybe NumCopies)
getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr
where
getattr = (NumCopies <$$> readish)
<$> checkAttr "annex.numcopies" file
{- Checks if numcopies are satisfied for a file by running a comparison
- between the number of (not untrusted) copies that are
- belived to exist, and the configured value. -}
numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v
numCopiesCheck file key vs = do
have <- trustExclude UnTrusted =<< Remote.keyLocations key
numCopiesCheck' file vs have
numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v
numCopiesCheck' file vs have = do
NumCopies needed <- getFileNumCopies file
return $ length have `vs` needed
{- Verifies that enough copies of a key exist amoung the listed remotes,
- priting an informative message if not.
-}
verifyEnoughCopies
:: String -- message to print when there are no known locations
-> Key
-> NumCopies
-> [UUID] -- repos to skip considering (generally untrusted remotes)
-> [VerifiedCopy] -- already known verifications
-> [Remote] -- remotes to check to see if they have it
-> Annex Bool
verifyEnoughCopies nolocmsg key need skip preverified tocheck =
helper [] [] (deDupVerifiedCopies preverified) (nub tocheck)
where
helper bad missing have []
| NumCopies (length have) >= need = return True
| otherwise = do
notEnoughCopies key need have (skip++missing) bad nolocmsg
return False
helper bad missing have (r:rs)
| verifiedEnoughCopies need have = do
stillhave <- liftIO $ filterM checkVerifiedCopy have
if verifiedEnoughCopies need stillhave
then return True
else helper bad missing stillhave (r:rs)
| any (== u) (map toUUID have) = helper bad missing have rs
| otherwise = do
haskey <- Remote.hasKey r key
case haskey of
Right True -> helper bad missing (mkVerifiedCopy RecentlyVerifiedCopy u : have) rs
Left _ -> helper (r:bad) missing have rs
Right False -> helper bad (u:missing) have rs
where
u = Remote.uuid r
{- Check whether enough verification has been done of copies to allow
- dropping content safely.
-
- Unless numcopies is 0, at least one VerifiedCopyLock is required.
- This prevents races between concurrent drops from dropping the last
- copy, no matter what.
-
- The other N-1 copies can be less strong verifications. While those
- are subject to concurrent drop races, and so could be dropped
- all at once, causing numcopies to be violated, this is the best that can
- be done without requiring all special remotes to support locking.
-}
verifiedEnoughCopies :: NumCopies -> [VerifiedCopy] -> Bool
verifiedEnoughCopies (NumCopies n) l
| n == 0 = True
| otherwise = length l >= n && any islock l
where
islock (VerifiedCopyLock _) = True
islock _ = False
notEnoughCopies :: Key -> NumCopies -> [VerifiedCopy] -> [UUID] -> [Remote] -> String -> Annex ()
notEnoughCopies key need have skip bad nolocmsg = do
showNote "unsafe"
showLongNote $
"Could only verify the existence of " ++
show (length have) ++ " out of " ++ show (fromNumCopies need) ++
" necessary copies"
Remote.showTriedRemotes bad
Remote.showLocations True key (map toUUID have++skip) nolocmsg
{- Cost ordered lists of remotes that the location log indicates
- may have a key.
-
- Also returns a list of UUIDs that are trusted to have the key
- (some may not have configured remotes). If the current repository
- currently has the key, and is not untrusted, it is included in this list.
-}
knownCopies :: Key -> Annex ([Remote], [UUID])
knownCopies key = do
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
u <- getUUID
trusteduuids' <- ifM (inAnnex key <&&> (<= SemiTrusted) <$> lookupTrust u)
( pure (u:trusteduuids)
, pure trusteduuids
)
return (remotes, trusteduuids')
|
