blob: babd1c00cf1cef7c7e170edffe011ba45cdac358 (
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
|
{- user-specified limits on files to act on
-
- Copyright 2011 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 Common.Annex
import qualified Annex
import qualified Utility.Matcher
import qualified Remote
import qualified Backend
import Annex.Content
import Logs.Trust
import Utility.HumanTime
type Limit = Utility.Matcher.Token (FilePath -> Annex Bool)
{- 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 :: Limit -> 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 :: (FilePath -> Annex Bool) -> Annex ()
addLimit = add . Utility.Matcher.Operation
{- Add a limit to skip files that do not match the glob. -}
addInclude :: String -> Annex ()
addInclude glob = addLimit $ return . matchglob glob
{- Add a limit to skip files that match the glob. -}
addExclude :: String -> Annex ()
addExclude glob = addLimit $ 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 name = addLimit $ check $ if name == "." then inAnnex else inremote
where
check a = Backend.lookupFile >=> handle a
handle _ Nothing = return False
handle a (Just (key, _)) = a key
inremote key = do
u <- Remote.nameToUUID name
us <- Remote.keyLocations key
return $ u `elem` us
{- Adds a limit to skip files not believed to have the specified number
- of copies. -}
addCopies :: String -> Annex ()
addCopies trust_num = addLimit . check $ readnum num
where
(num, mayCheckTrust) = case split ":" trust_num of
[trust, num'] -> (num', checkTrust (readtrust trust))
[num'] -> (num', const (return True))
_ -> bad
readnum = maybe bad id . readish
readtrust = maybe bad id . readTrust
check n = Backend.lookupFile >=> handle n
handle _ Nothing = return False
handle n (Just (key, _)) = do
us <- filterM mayCheckTrust =<< Remote.keyLocations key
return $ length us >= n
checkTrust t u = (== t) <$> lookupTrust u
bad = error "bad number or trust:number for --copies"
{- Adds a limit to skip files not using a specified key-value backend. -}
addInBackend :: String -> Annex ()
addInBackend name = addLimit $ Backend.lookupFile >=> check
where
wanted = Backend.lookupBackendName name
check = return . maybe False ((==) wanted . snd)
addTimeLimit :: String -> Annex ()
addTimeLimit s = do
let seconds = fromMaybe (error "bad time-limit") $ parseDuration s
start <- liftIO getPOSIXTime
let cutoff = start + seconds
addLimit $ const $ do
now <- liftIO getPOSIXTime
if now > cutoff
then do
warning $ "Time limit (" ++ s ++ ") reached!"
liftIO $ exitWith $ ExitFailure 101
else return True
|
