7bb4d507ba
Solves the issue with preferred content expressions and dropping that I mentioned yesterday. My solution was to add a parameter to specify a set of repositories where content should be assumed not to be present. When deciding whether to drop, it can put the current repository in, and then if the expression fails to match, the content can be dropped. Using yesterday's example "(not copies=trusted:2) and (not in=usbdrive)", when the local repo is one of the 2 trusted copies, the drop check will see only 1 trusted copy, so the expression matches, and so the content will not be dropped.
157 lines
4.7 KiB
Haskell
157 lines
4.7 KiB
Haskell
{- 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 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 Logs.Group
|
|
import Utility.HumanTime
|
|
|
|
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 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)
|
|
|
|
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
|