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
|
{- git-annex assistant dropping of unwanted content
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Assistant.Drop where
import Assistant.Common
import Assistant.DaemonStatus
import Logs.Location
import Logs.Trust
import Types.Remote (uuid)
import qualified Remote
import qualified Command.Drop
import Command
import Annex.Wanted
import Annex.Exception
import Config
import Annex.Content.Direct
import qualified Data.Set as S
type Reason = String
{- Drop from local and/or remote when allowed by the preferred content and
- numcopies settings. -}
handleDrops :: Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant ()
handleDrops _ _ _ Nothing _ = noop
handleDrops reason fromhere key f knownpresentremote = do
syncrs <- syncDataRemotes <$> getDaemonStatus
locs <- liftAnnex $ loggedLocations key
handleDropsFrom locs syncrs reason fromhere key f knownpresentremote
{- The UUIDs are ones where the content is believed to be present.
- The Remote list can include other remotes that do not have the content;
- only ones that match the UUIDs will be dropped from.
- If allowed to drop fromhere, that drop will be tried first.
-
- In direct mode, all associated files are checked, and only if all
- of them are unwanted are they dropped.
-}
handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant ()
handleDropsFrom _ _ _ _ _ Nothing _ = noop
handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
fs <- liftAnnex $ ifM isDirect
( do
l <- associatedFilesRelative key
if null l
then return [afile]
else return l
, return [afile]
)
n <- getcopies fs
if fromhere && checkcopies n Nothing
then go fs rs =<< dropl fs n
else go fs rs n
where
getcopies fs = liftAnnex $ do
(untrusted, have) <- trustPartition UnTrusted locs
numcopies <- maximum <$> mapM (getNumCopies <=< numCopies) fs
return (length have, numcopies, S.fromList untrusted)
{- Check that we have enough copies still to drop the content.
- When the remote being dropped from is untrusted, it was not
- counted as a copy, so having only numcopies suffices. Otherwise,
- we need more than numcopies to safely drop. -}
checkcopies (have, numcopies, _untrusted) Nothing = have > numcopies
checkcopies (have, numcopies, untrusted) (Just u)
| S.member u untrusted = have >= numcopies
| otherwise = have > numcopies
decrcopies (have, numcopies, untrusted) Nothing =
(have - 1, numcopies, untrusted)
decrcopies v@(_have, _numcopies, untrusted) (Just u)
| S.member u untrusted = v
| otherwise = decrcopies v Nothing
go _ [] _ = noop
go fs (r:rest) n
| uuid r `S.notMember` slocs = go fs rest n
| checkcopies n (Just $ Remote.uuid r) =
dropr fs r n >>= go fs rest
| otherwise = noop
checkdrop fs n@(have, numcopies, _untrusted) u a =
ifM (liftAnnex $ allM (wantDrop True u . Just) fs)
( ifM (liftAnnex $ safely $ doCommand $ a (Just numcopies))
( do
debug
[ "dropped"
, afile
, "(from " ++ maybe "here" show u ++ ")"
, "(copies now " ++ show (have - 1) ++ ")"
, ": " ++ reason
]
return $ decrcopies n u
, return n
)
, return n
)
dropl fs n = checkdrop fs n Nothing $ \numcopies ->
Command.Drop.startLocal (Just afile) numcopies key knownpresentremote
dropr fs r n = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
Command.Drop.startRemote (Just afile) numcopies key r
safely a = either (const False) id <$> tryAnnex a
slocs = S.fromList locs
|
