This commit is contained in:
Joey Hess 2015-12-15 15:34:28 -04:00
parent 0ddcaae9c1
commit cdd27b8920
Failed to extract signature
11 changed files with 54 additions and 43 deletions

View file

@ -399,7 +399,7 @@ changedDirect oldk f = do
whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ whenM (pure (null locs) <&&> not <$> inAnnex oldk) $
logStatus oldk InfoMissing logStatus oldk InfoMissing
{- Enable/disable direct mode. -} {- Git config settings to enable/disable direct mode. -}
setDirect :: Bool -> Annex () setDirect :: Bool -> Annex ()
setDirect wantdirect = do setDirect wantdirect = do
if wantdirect if wantdirect

View file

@ -22,7 +22,7 @@ import Git.Sha
import Git.HashObject import Git.HashObject
import Git.Types import Git.Types
import Git.FilePath import Git.FilePath
import qualified Backend import Annex.WorkTree
import Annex.Index import Annex.Index
import Annex.Link import Annex.Link
import Annex.CatFile import Annex.CatFile
@ -342,7 +342,7 @@ applyView' mkviewedfile getfilemetadata view = do
hasher <- inRepo hashObjectStart hasher <- inRepo hashObjectStart
forM_ l $ \f -> do forM_ l $ \f -> do
relf <- getTopFilePath <$> inRepo (toTopFilePath f) relf <- getTopFilePath <$> inRepo (toTopFilePath f)
go uh hasher relf =<< Backend.lookupFile f go uh hasher relf =<< lookupFile f
liftIO $ do liftIO $ do
hashObjectStop hasher hashObjectStop hasher
void $ stopUpdateIndex uh void $ stopUpdateIndex uh

35
Annex/WorkTree.hs Normal file
View file

@ -0,0 +1,35 @@
{- git-annex worktree files
-
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.WorkTree where
import Common.Annex
import Annex.Link
import Annex.CatFile
{- Looks up the key corresponding to an annexed file,
- by examining what the file links to.
-
- An unlocked file will not have a link on disk, so fall back to
- looking for a pointer to a key in git.
-}
lookupFile :: FilePath -> Annex (Maybe Key)
lookupFile file = do
mkey <- isAnnexLink file
case mkey of
Just key -> makeret key
Nothing -> maybe (return Nothing) makeret =<< catKeyFile file
where
makeret = return . Just
{- Modifies an action to only act on files that are already annexed,
- and passes the key on to it. -}
whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a
ifAnnexed file yes no = maybe no yes =<< lookupFile file

View file

@ -25,7 +25,7 @@ import Utility.ThreadScheduler
import Utility.NotificationBroadcaster import Utility.NotificationBroadcaster
import Utility.Batch import Utility.Batch
import qualified Git.LsFiles as LsFiles import qualified Git.LsFiles as LsFiles
import qualified Backend import Annex.WorkTree
import Annex.Content import Annex.Content
import Annex.Wanted import Annex.Wanted
import CmdLine.Action import CmdLine.Action
@ -142,7 +142,7 @@ expensiveScan urlrenderer rs = batch <~> do
(unwanted', ts) <- maybe (unwanted', ts) <- maybe
(return (unwanted, [])) (return (unwanted, []))
(findtransfers f unwanted) (findtransfers f unwanted)
=<< liftAnnex (Backend.lookupFile f) =<< liftAnnex (lookupFile f)
mapM_ (enqueue f) ts mapM_ (enqueue f) ts
scan unwanted' fs scan unwanted' fs

View file

@ -28,7 +28,7 @@ import qualified Annex.Queue
import qualified Git import qualified Git
import qualified Git.UpdateIndex import qualified Git.UpdateIndex
import qualified Git.LsFiles as LsFiles import qualified Git.LsFiles as LsFiles
import qualified Backend import Annex.WorkTree
import Annex.Direct import Annex.Direct
import Annex.Content.Direct import Annex.Content.Direct
import Annex.CatFile import Annex.CatFile
@ -270,7 +270,7 @@ onAddDirect symlinkssupported matcher file fs = do
onAddSymlink :: Bool -> Handler onAddSymlink :: Bool -> Handler
onAddSymlink isdirect file filestatus = unlessIgnored file $ do onAddSymlink isdirect file filestatus = unlessIgnored file $ do
linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file) linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
kv <- liftAnnex (Backend.lookupFile file) kv <- liftAnnex (lookupFile file)
onAddSymlink' linktarget kv isdirect file filestatus onAddSymlink' linktarget kv isdirect file filestatus
onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler

View file

@ -9,7 +9,6 @@ module Backend (
list, list,
orderedList, orderedList,
genKey, genKey,
lookupFile,
getBackend, getBackend,
chooseBackend, chooseBackend,
lookupBackendName, lookupBackendName,
@ -20,8 +19,6 @@ module Backend (
import Common.Annex import Common.Annex
import qualified Annex import qualified Annex
import Annex.CheckAttr import Annex.CheckAttr
import Annex.CatFile
import Annex.Link
import Types.Key import Types.Key
import Types.KeySource import Types.KeySource
import qualified Types.Backend as B import qualified Types.Backend as B
@ -76,21 +73,6 @@ genKey' (b:bs) source = do
| c == '\n' = '_' | c == '\n' = '_'
| otherwise = c | otherwise = c
{- Looks up the key corresponding to an annexed file,
- by examining what the file links to.
-
- An unlocked file will not have a link on disk, so fall back to
- looking for a pointer to a key in git.
-}
lookupFile :: FilePath -> Annex (Maybe Key)
lookupFile file = do
mkey <- isAnnexLink file
case mkey of
Just key -> makeret key
Nothing -> maybe (return Nothing) makeret =<< catKeyFile file
where
makeret = return . Just
getBackend :: FilePath -> Key -> Annex (Maybe Backend) getBackend :: FilePath -> Key -> Annex (Maybe Backend)
getBackend file k = let bname = keyBackendName k in getBackend file k = let bname = keyBackendName k in
case maybeLookupBackendName bname of case maybeLookupBackendName bname of

View file

@ -18,12 +18,13 @@ module Command (
stopUnless, stopUnless,
whenAnnexed, whenAnnexed,
ifAnnexed, ifAnnexed,
lookupFile,
isBareRepo, isBareRepo,
module ReExported module ReExported
) where ) where
import Common.Annex import Common.Annex
import qualified Backend import Annex.WorkTree
import qualified Git import qualified Git
import Types.Command as ReExported import Types.Command as ReExported
import Types.Option as ReExported import Types.Option as ReExported
@ -100,13 +101,5 @@ stop = return Nothing
stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a) stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
stopUnless c a = ifM c ( a , stop ) stopUnless c a = ifM c ( a , stop )
{- Modifies an action to only act on files that are already annexed,
- and passes the key on to it. -}
whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a
ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file
isBareRepo :: Annex Bool isBareRepo :: Annex Bool
isBareRepo = fromRepo Git.repoIsLocalBare isBareRepo = fromRepo Git.repoIsLocalBare

View file

@ -24,7 +24,6 @@ import qualified Git.Branch
import qualified Git.RefLog import qualified Git.RefLog
import qualified Git.LsFiles as LsFiles import qualified Git.LsFiles as LsFiles
import qualified Git.DiffTree as DiffTree import qualified Git.DiffTree as DiffTree
import qualified Backend
import qualified Remote import qualified Remote
import qualified Annex.Branch import qualified Annex.Branch
import Annex.CatFile import Annex.CatFile
@ -215,7 +214,7 @@ withKeysReferenced' mdir initial a = do
Just dir -> inRepo $ LsFiles.inRepo [dir] Just dir -> inRepo $ LsFiles.inRepo [dir]
go v [] = return v go v [] = return v
go v (f:fs) = do go v (f:fs) = do
x <- Backend.lookupFile f x <- lookupFile f
case x of case x of
Nothing -> go v fs Nothing -> go v fs
Just k -> do Just k -> do
@ -266,7 +265,7 @@ withKeysReferencedInGitRef a ref = do
forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a
liftIO $ void clean liftIO $ void clean
where where
tKey True = Backend.lookupFile . getTopFilePath . DiffTree.file tKey True = lookupFile . getTopFilePath . DiffTree.file
tKey False = fileKey . takeFileName . decodeBS <$$> tKey False = fileKey . takeFileName . decodeBS <$$>
catFile ref . getTopFilePath . DiffTree.file catFile ref . getTopFilePath . DiffTree.file

View file

@ -13,6 +13,7 @@ import Upgrade
cmd :: Command cmd :: Command
cmd = dontCheck repoExists $ -- because an old version may not seem to exist cmd = dontCheck repoExists $ -- because an old version may not seem to exist
noDaemonRunning $ -- avoid upgrading repo out from under daemon
command "upgrade" SectionMaintenance "upgrade repository layout" command "upgrade" SectionMaintenance "upgrade repository layout"
paramNothing (withParams seek) paramNothing (withParams seek)

View file

@ -11,8 +11,8 @@ import Common.Annex
import qualified Annex import qualified Annex
import qualified Utility.Matcher import qualified Utility.Matcher
import qualified Remote import qualified Remote
import qualified Backend
import Annex.Content import Annex.Content
import Annex.WorkTree
import Annex.Action import Annex.Action
import Annex.UUID import Annex.UUID
import Logs.Trust import Logs.Trust
@ -277,7 +277,7 @@ addTimeLimit s = do
else return True else return True
lookupFileKey :: FileInfo -> Annex (Maybe Key) lookupFileKey :: FileInfo -> Annex (Maybe Key)
lookupFileKey = Backend.lookupFile . currFile lookupFileKey = lookupFile . currFile
checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a

View file

@ -65,6 +65,7 @@ import qualified Types.Messages
import qualified Config import qualified Config
import qualified Config.Cost import qualified Config.Cost
import qualified Crypto import qualified Crypto
import qualified Annex.WorkTree
import qualified Annex.Init import qualified Annex.Init
import qualified Annex.CatFile import qualified Annex.CatFile
import qualified Annex.View import qualified Annex.View
@ -810,7 +811,7 @@ test_unused = intmpclonerepoInDirect $ do
assertEqual ("unused keys differ " ++ desc) assertEqual ("unused keys differ " ++ desc)
(sort expectedkeys) (sort unusedkeys) (sort expectedkeys) (sort unusedkeys)
findkey f = do findkey f = do
r <- Backend.lookupFile f r <- Annex.WorkTree.lookupFile f
return $ fromJust r return $ fromJust r
test_describe :: Assertion test_describe :: Assertion
@ -1380,7 +1381,7 @@ test_crypto = do
(c,k) <- annexeval $ do (c,k) <- annexeval $ do
uuid <- Remote.nameToUUID "foo" uuid <- Remote.nameToUUID "foo"
rs <- Logs.Remote.readRemoteLog rs <- Logs.Remote.readRemoteLog
Just k <- Backend.lookupFile annexedfile Just k <- Annex.WorkTree.lookupFile annexedfile
return (fromJust $ M.lookup uuid rs, k) return (fromJust $ M.lookup uuid rs, k)
let key = if scheme `elem` ["hybrid","pubkey"] let key = if scheme `elem` ["hybrid","pubkey"]
then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId] then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
@ -1684,7 +1685,7 @@ checkdangling f = ifM (annexeval Config.crippledFileSystem)
checklocationlog :: FilePath -> Bool -> Assertion checklocationlog :: FilePath -> Bool -> Assertion
checklocationlog f expected = do checklocationlog f expected = do
thisuuid <- annexeval Annex.UUID.getUUID thisuuid <- annexeval Annex.UUID.getUUID
r <- annexeval $ Backend.lookupFile f r <- annexeval $ Annex.WorkTree.lookupFile f
case r of case r of
Just k -> do Just k -> do
uuids <- annexeval $ Remote.keyLocations k uuids <- annexeval $ Remote.keyLocations k
@ -1695,7 +1696,7 @@ checklocationlog f expected = do
checkbackend :: FilePath -> Types.Backend -> Assertion checkbackend :: FilePath -> Types.Backend -> Assertion
checkbackend file expected = do checkbackend file expected = do
b <- annexeval $ maybe (return Nothing) (Backend.getBackend file) b <- annexeval $ maybe (return Nothing) (Backend.getBackend file)
=<< Backend.lookupFile file =<< Annex.WorkTree.lookupFile file
assertEqual ("backend for " ++ file) (Just expected) b assertEqual ("backend for " ++ file) (Just expected) b
inlocationlog :: FilePath -> Assertion inlocationlog :: FilePath -> Assertion