blob: f9e8de270e06854bb85b007a983483a035c7ada0 (
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
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
|
{- user-specified limits on files to act on
-
- Copyright 2011,2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Limit where
import Text.Regex.PCRE.Light.Char8
import System.Path.WildMatch
import Data.Time.Clock.POSIX
import qualified Data.Set as S
import qualified Data.Map as M
import Common.Annex
import qualified Annex
import qualified Utility.Matcher
import qualified Remote
import qualified Backend
import Annex.Content
import Annex.UUID
import Logs.Trust
import Types.TrustLevel
import Types.Key
import Types.Group
import Logs.Group
import Utility.HumanTime
import Utility.DataUnits
type MatchFiles = AssumeNotPresent -> FilePath -> Annex Bool
type MkLimit = String -> Either String MatchFiles
type AssumeNotPresent = S.Set UUID
{- Checks if there are user-specified limits. -}
limited :: Annex Bool
limited = (not . Utility.Matcher.matchesAny) <$> getMatcher'
{- Gets a matcher for the user-specified limits. The matcher is cached for
- speed; once it's obtained the user-specified limits can't change. -}
getMatcher :: Annex (FilePath -> Annex Bool)
getMatcher = Utility.Matcher.matchM <$> getMatcher'
getMatcher' :: Annex (Utility.Matcher.Matcher (FilePath -> Annex Bool))
getMatcher' = do
m <- Annex.getState Annex.limit
case m of
Right r -> return r
Left l -> do
let matcher = Utility.Matcher.generate (reverse l)
Annex.changeState $ \s -> s { Annex.limit = Right matcher }
return matcher
{- Adds something to the limit list, which is built up reversed. -}
add :: Utility.Matcher.Token (FilePath -> Annex Bool) -> Annex ()
add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
where
prepend (Left ls) = Left $ l:ls
prepend _ = error "internal"
{- Adds a new token. -}
addToken :: String -> Annex ()
addToken = add . Utility.Matcher.token
{- Adds a new limit. -}
addLimit :: Either String MatchFiles -> Annex ()
addLimit = either error (\l -> add $ Utility.Matcher.Operation $ l S.empty)
{- Add a limit to skip files that do not match the glob. -}
addInclude :: String -> Annex ()
addInclude = addLimit . limitInclude
limitInclude :: MkLimit
limitInclude glob = Right $ const $ return . matchglob glob
{- Add a limit to skip files that match the glob. -}
addExclude :: String -> Annex ()
addExclude = addLimit . limitExclude
limitExclude :: MkLimit
limitExclude glob = Right $ const $ return . not . matchglob glob
matchglob :: String -> FilePath -> Bool
matchglob glob f = isJust $ match cregex f []
where
cregex = compile regex []
regex = '^':wildToRegex glob
{- Adds a limit to skip files not believed to be present
- in a specfied repository. -}
addIn :: String -> Annex ()
addIn = addLimit . limitIn
limitIn :: MkLimit
limitIn name = Right $ \notpresent -> check $
if name == "."
then inhere notpresent
else inremote notpresent
where
check a = Backend.lookupFile >=> handle a
handle _ Nothing = return False
handle a (Just (key, _)) = a key
inremote notpresent key = do
u <- Remote.nameToUUID name
us <- Remote.keyLocations key
return $ u `elem` us && u `S.notMember` notpresent
inhere notpresent key
| S.null notpresent = inAnnex key
| otherwise = do
u <- getUUID
if u `S.member` notpresent
then return False
else inAnnex key
{- Adds a limit to skip files not believed to have the specified number
- of copies. -}
addCopies :: String -> Annex ()
addCopies = addLimit . limitCopies
limitCopies :: MkLimit
limitCopies want = case split ":" want of
[v, n] -> case readTrustLevel v of
Just trust -> go n $ checktrust trust
Nothing -> go n $ checkgroup v
[n] -> go n $ const $ return True
_ -> Left "bad value for copies"
where
go num good = case readish num of
Nothing -> Left "bad number for copies"
Just n -> Right $ \notpresent ->
Backend.lookupFile >=> handle n good notpresent
handle _ _ _ Nothing = return False
handle n good notpresent (Just (key, _)) = do
us <- filter (`S.notMember` notpresent)
<$> (filterM good =<< Remote.keyLocations key)
return $ length us >= n
checktrust t u = (== t) <$> lookupTrust u
checkgroup g u = S.member g <$> lookupGroups u
{- Adds a limit to skip files not believed to be present in all
- repositories in the specified group. -}
addInGroup :: String -> Annex ()
addInGroup groupname = do
m <- groupMap
addLimit $ limitInGroup m groupname
limitInGroup :: GroupMap -> MkLimit
limitInGroup m groupname
| S.null want = Right $ const $ const $ return True
| otherwise = Right $ \notpresent ->
Backend.lookupFile >=> check notpresent
where
want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
check _ Nothing = return False
check notpresent (Just (key, _))
-- optimisation: Check if a wanted uuid is notpresent.
| not (S.null (S.intersection want notpresent)) = return False
| otherwise = do
present <- S.fromList <$> Remote.keyLocations key
return $ S.null $ want `S.difference` present
{- Adds a limit to skip files not using a specified key-value backend. -}
addInBackend :: String -> Annex ()
addInBackend = addLimit . limitInBackend
limitInBackend :: MkLimit
limitInBackend name = Right $ const $ Backend.lookupFile >=> check
where
wanted = Backend.lookupBackendName name
check = return . maybe False ((==) wanted . snd)
{- Adds a limit to skip files that are too large or too small -}
addLargerThan :: String -> Annex ()
addLargerThan = addLimit . limitSize (>)
addSmallerThan :: String -> Annex ()
addSmallerThan = addLimit . limitSize (<)
limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit
limitSize vs s = case readSize dataUnits s of
Nothing -> Left "bad size"
Just sz -> Right $ const $ Backend.lookupFile >=> check sz
where
check _ Nothing = return False
check sz (Just (key, _)) = return $ keySize key `vs` Just sz
addTimeLimit :: String -> Annex ()
addTimeLimit s = do
let seconds = fromMaybe (error "bad time-limit") $ parseDuration s
start <- liftIO getPOSIXTime
let cutoff = start + seconds
addLimit $ Right $ const $ const $ do
now <- liftIO getPOSIXTime
if now > cutoff
then do
warning $ "Time limit (" ++ s ++ ") reached!"
liftIO $ exitWith $ ExitFailure 101
else return True
|
