wired preferred content up to get, copy, and drop --auto

This commit is contained in:
Joey Hess 2012-10-08 13:16:53 -04:00
parent 888981eaae
commit 71fd18a97f
8 changed files with 104 additions and 9 deletions

View file

@ -21,7 +21,7 @@ module Command (
isBareRepo,
numCopies,
autoCopies,
autoCopiesWith,
autoCopiesDrop,
module ReExported
) where
@ -38,6 +38,11 @@ import Usage as ReExported
import Logs.Trust
import Config
import Annex.CheckAttr
import Logs.PreferredContent
import Git.FilePath
import Annex.UUID
import qualified Data.Set as S
{- Generates a normal command -}
command :: String -> String -> [CommandSeek] -> String -> Command
@ -113,7 +118,8 @@ numCopies file = readish <$> checkAttr "annex.numcopies" file
-
- In auto mode, first checks that the number of known
- copies of the key is > or < than the numcopies setting, before running
- the action. -}
- the action. Also checks any preferred content settings.
-}
autoCopies :: FilePath -> Key -> (Int -> Int -> Bool) -> CommandStart -> CommandStart
autoCopies file key vs a = Annex.getState Annex.auto >>= go
where
@ -122,10 +128,20 @@ autoCopies file key vs a = Annex.getState Annex.auto >>= go
numcopiesattr <- numCopies file
needed <- getNumCopies numcopiesattr
(_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
if length have `vs` needed then a else stop
if length have `vs` needed
then do
fp <- inRepo $ toTopFilePath file
ifM (isPreferredContent Nothing S.empty fp)
( a, stop )
else stop
autoCopiesWith :: FilePath -> Key -> (Int -> Int -> Bool) -> (Maybe Int -> CommandStart) -> CommandStart
autoCopiesWith file key vs a = do
{- For dropping, supplies the number of known copies to the action.
-
- In auto mode, checks the number of known copies.
- Also, checks if the repo would prefer to retain the content.
-}
autoCopiesDrop :: FilePath -> Key -> (Int -> Int -> Bool) -> (Maybe Int -> CommandStart) -> CommandStart
autoCopiesDrop file key vs a = do
numcopiesattr <- numCopies file
Annex.getState Annex.auto >>= auto numcopiesattr
where
@ -133,4 +149,10 @@ autoCopiesWith file key vs a = do
auto numcopiesattr True = do
needed <- getNumCopies numcopiesattr
(_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
if length have `vs` needed then a numcopiesattr else stop
if length have `vs` needed
then do
fp <- inRepo $ toTopFilePath file
u <- getUUID
ifM (isPreferredContent (Just u) (S.singleton u) fp)
( stop, a numcopiesattr )
else stop

View file

@ -30,7 +30,7 @@ seek = [withField fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start from]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
start from file (key, _) = autoCopiesDrop file key (>) $ \numcopies ->
case from of
Nothing -> startLocal file numcopies key
Just remote -> do

View file

@ -7,6 +7,7 @@
module Logs.PreferredContent (
preferredContentSet,
isPreferredContent,
preferredContentMap,
preferredContentMapRaw,
checkPreferredContentExpression,
@ -20,8 +21,10 @@ import Common.Annex
import qualified Annex.Branch
import qualified Annex
import Logs.UUIDBased
import Limit (MatchFiles, limitInclude, limitExclude, limitIn, limitCopies, limitInBackend)
import Limit (MatchFiles, AssumeNotPresent, limitInclude, limitExclude, limitIn, limitCopies, limitInBackend)
import qualified Utility.Matcher
import Annex.UUID
import Git.FilePath
{- Filename of preferred-content.log. -}
preferredContentLog :: FilePath
@ -36,6 +39,18 @@ preferredContentSet uuid@(UUID _) val = do
Annex.changeState $ \s -> s { Annex.groupmap = Nothing }
preferredContentSet NoUUID _ = error "unknown UUID; cannot modify"
{- Checks if a file is preferred content for the specified repository
- (or the current repository if none is specified). -}
isPreferredContent :: Maybe UUID -> AssumeNotPresent -> TopFilePath -> Annex Bool
isPreferredContent mu notpresent file = do
u <- maybe getUUID return mu
m <- preferredContentMap
case M.lookup u m of
Nothing -> return True
Just matcher ->
Utility.Matcher.matchM2 matcher notpresent $
getTopFilePath file
{- Read the preferredContentLog into a map. The map is cached for speed. -}
preferredContentMap :: Annex Annex.PreferredContentMap
preferredContentMap = do

View file

@ -23,6 +23,7 @@ module Utility.Matcher (
generate,
match,
matchM,
matchM2,
matchesAny
) where
@ -96,6 +97,15 @@ matchM m v = go m
go (MNot m1) = liftM not (go m1)
go (MOp o) = o v
matchM2 :: Monad m => Matcher (v1 -> v2 -> m Bool) -> v1 -> v2 -> m Bool
matchM2 m v1 v2 = go m
where
go MAny = return True
go (MAnd m1 m2) = go m1 <&&> go m2
go (MOr m1 m2) = go m1 <||> go m2
go (MNot m1) = liftM not (go m1)
go (MOp o) = o v1 v2
{- Checks is a matcher contains no limits, and so (presumably) matches
- anything. Note that this only checks the trivial case; it is possible
- to construct matchers that match anything but are more complicated. -}

5
debian/changelog vendored
View file

@ -8,6 +8,11 @@ git-annex (3.20121002) UNRELEASED; urgency=low
as normal files.
* vicfg: New command, allows editing (or simply viewing) most
of the repository configuration settings stored in the git-annex branch.
* Added preferred content expressions, configurable using vicfg.
* get --auto, copy --auto: If the local repository has preferred content
configured, only get that content.
* drop --auto: If the local repository has preferred content configured,
drop content that is not preferred, if numcopies allows.
* Only build-depend on libghc-clientsession-dev on arches that will have
the webapp.
* uninit: Unset annex.version. Closes: #689852

View file

@ -502,7 +502,8 @@ subdirectories).
* --auto
Enables automatic mode. Commands that get, drop, or move file contents
will only do so when needed to help satisfy the setting of annex.numcopies.
will only do so when needed to help satisfy the setting of annex.numcopies,
and preferred content configuration.
* --quiet

View file

@ -0,0 +1,37 @@
git-annex tries to ensure that the configured number of [[copies]] of your
data always exist, and leaves it up to you to use commands like `git annex
get` and `git annex drop` to move the content to the repositories you want
to contain it. But sometimes, it can be good to have more fine-grained
control over which repositories prefer to have which content. Configuring
this allows `git annex get --auto`, `git annex drop --auto`, etc to do
smarter things.
Currently, preferred content settings can only be edited using `git
annex vicfg`. Each repository can have its own settings, and other
repositories may also try to honor those settings. So there's no local
`.git/config` setting it.
The idea is that you write an expression that files are matched against.
If a file matches, it's preferred to have its content stored in the
repository. If it doesn't, it's preferred to drop its content from
the repository (if there are enough copies elsewhere).
The expressions are very similar to the file matching options documented
on the [[git-annex]] man page. At the command line, you can use those
options in commands like this:
git annex get --include='*.mp3' --and -'(' --not --in=archive -')'
The equivilant preferred content expression looks like this:
include=*.mp3 and (not in=archive)
So, just remove the dashes, basically.
Note that while --include and --exclude match files relative to the current
directory, preferred content expressions always match files relative to the
top of the git repository. Perhaps you put files into `out/` directories
when you're done with them. Then you could configure your laptop to prefer
to not retain those files, like this:
exclude=*/out/*

View file

@ -38,3 +38,8 @@ work toward having two copies of your files.
The --auto option can also be used with the copy command,
again this lets git-annex decide whether to actually copy content.
The above shows how to use --auto to manage content based on the number
of copies. It's also possible to configure, on a per-repository basis,
which content is desired. Then --auto also takes that into account
see [[preferred_content]] for details.