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
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
{- git-annex command
-
- Copyright 2010 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Drop where
import Common.Annex
import Command
import qualified Remote
import qualified Annex
import Annex.UUID
import Logs.Location
import Logs.Trust
import Logs.PreferredContent
import Config.NumCopies
import Annex.Content
import Annex.Wanted
import Annex.Notification
import qualified Data.Set as S
cmd :: [Command]
cmd = [withOptions (dropOptions) $ command "drop" paramPaths seek
SectionCommon "indicate content of files not currently wanted"]
dropOptions :: [Option]
dropOptions = dropFromOption : annexedMatchingOptions
dropFromOption :: Option
dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
seek :: CommandSeek
seek ps = do
from <- getOptionField dropFromOption Remote.byNameWithUUID
withFilesInGit (whenAnnexed $ start from) ps
start :: Maybe Remote -> FilePath -> Key -> CommandStart
start from file key = checkDropAuto from file key $ \numcopies ->
stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just key) (Just file)) $
case from of
Nothing -> startLocal (Just file) numcopies key Nothing
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal (Just file) numcopies key Nothing
else startRemote (Just file) numcopies key remote
startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
showStart' "drop" key afile
next $ performLocal key afile numcopies knownpresentremote
startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart
startRemote afile numcopies key remote = do
showStart' ("drop " ++ Remote.name remote) key afile
next $ performRemote key afile numcopies remote
-- Note that lockContent is called before checking if the key is present
-- on enough remotes to allow removal. This avoids a scenario where two
-- or more remotes are trying to remove a key at the same time, and each
-- see the key is present on the other.
performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform
performLocal key afile numcopies knownpresentremote = lockContent key $ \contentlock -> do
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
let trusteduuids' = case knownpresentremote of
Nothing -> trusteduuids
Just r -> nub (Remote.uuid r:trusteduuids)
untrusteduuids <- trustGet UnTrusted
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
u <- getUUID
ifM (canDrop u key afile numcopies trusteduuids' tocheck [])
( do
removeAnnex contentlock
notifyDrop afile True
next $ cleanupLocal key
, do
notifyDrop afile False
stop
)
performRemote :: Key -> AssociatedFile -> NumCopies -> Remote -> CommandPerform
performRemote key afile numcopies remote = do
-- Filter the remote it's being dropped from out of the lists of
-- places assumed to have the key, and places to check.
-- When the local repo has the key, that's one additional copy,
-- as long asthe local repo is not untrusted.
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
present <- inAnnex key
u <- getUUID
trusteduuids' <- if present
then ifM ((<= SemiTrusted) <$> lookupTrust u)
( pure (u:trusteduuids)
, pure trusteduuids
)
else pure trusteduuids
let have = filter (/= uuid) trusteduuids'
untrusteduuids <- trustGet UnTrusted
let tocheck = filter (/= remote) $
Remote.remotesWithoutUUID remotes (have++untrusteduuids)
stopUnless (canDrop uuid key afile numcopies have tocheck [uuid]) $ do
ok <- Remote.removeKey remote key
next $ cleanupRemote key remote ok
where
uuid = Remote.uuid remote
cleanupLocal :: Key -> CommandCleanup
cleanupLocal key = do
logStatus key InfoMissing
return True
cleanupRemote :: Key -> Remote -> Bool -> CommandCleanup
cleanupRemote key remote ok = do
when ok $
Remote.logStatus remote key InfoMissing
return ok
{- Checks specified remotes to verify that enough copies of a key exist to
- allow it to be safely removed (with no data loss). Can be provided with
- some locations where the key is known/assumed to be present.
-
- Also checks if it's required content, and refuses to drop if so.
-
- --force overrides and always allows dropping.
-}
canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
canDrop dropfrom key afile numcopies have check skip = ifM (Annex.getState Annex.force)
( return True
, checkRequiredContent dropfrom key afile
<&&>
findCopies key numcopies skip have check
)
findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
findCopies key need skip = helper [] []
where
helper bad missing have []
| NumCopies (length have) >= need = return True
| otherwise = notEnoughCopies key need have (skip++missing) bad
helper bad missing have (r:rs)
| NumCopies (length have) >= need = return True
| otherwise = do
let u = Remote.uuid r
let duplicate = u `elem` have
haskey <- Remote.hasKey r key
case (duplicate, haskey) of
(False, Right True) -> helper bad missing (u:have) rs
(False, Left _) -> helper (r:bad) missing have rs
(False, Right False) -> helper bad (u:missing) have rs
_ -> helper bad missing have rs
notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
notEnoughCopies key need have skip bad = do
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 (have++skip)
"Rather than dropping this file, try using: git annex move"
hint
return False
where
unsafe = showNote "unsafe"
hint = showLongNote "(Use --force to override this check, or adjust numcopies.)"
checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool
checkRequiredContent u k afile =
ifM (isRequiredContent (Just u) S.empty (Just k) afile False)
( requiredContent
, return True
)
requiredContent :: Annex Bool
requiredContent = do
showLongNote "That file is required content, it cannot be dropped!"
showLongNote "(Use --force to override this check, or adjust required content configuration.)"
return False
{- In auto mode, only runs the action if there are enough
- copies on other semitrusted repositories. -}
checkDropAuto :: Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart
checkDropAuto mremote file key a = do
numcopies <- getFileNumCopies file
Annex.getState Annex.auto >>= auto numcopies
where
auto numcopies False = a numcopies
auto numcopies True = do
locs <- Remote.keyLocations key
uuid <- getUUID
let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote
locs' <- trustExclude UnTrusted $ filter (/= remoteuuid) locs
if NumCopies (length locs') >= numcopies
then a numcopies
else stop
|
