This commit is contained in:
Joey Hess 2020-07-10 14:17:35 -04:00
parent 4c9ad1de46
commit 7a42a47902
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
17 changed files with 31 additions and 34 deletions

View file

@ -351,7 +351,7 @@ applyView' mkviewedfile getfilemetadata view = do
withUpdateIndex viewg $ \uh -> do withUpdateIndex viewg $ \uh -> do
forM_ l $ \(f, sha, mode) -> do forM_ l $ \(f, sha, mode) -> do
topf <- inRepo (toTopFilePath f) topf <- inRepo (toTopFilePath f)
go uh topf sha (toTreeItemType mode) =<< lookupFile f go uh topf sha (toTreeItemType mode) =<< lookupKey f
liftIO $ void clean liftIO $ void clean
genViewBranch view genViewBranch view
where where

View file

@ -35,8 +35,8 @@ import Control.Concurrent
- When in an adjusted branch that may have hidden the file, looks for a - When in an adjusted branch that may have hidden the file, looks for a
- pointer to a key in the original branch. - pointer to a key in the original branch.
-} -}
lookupFile :: RawFilePath -> Annex (Maybe Key) lookupKey :: RawFilePath -> Annex (Maybe Key)
lookupFile = lookupFile' catkeyfile lookupKey = lookupKey' catkeyfile
where where
catkeyfile file = catkeyfile file =
ifM (liftIO $ doesFileExist $ fromRawFilePath file) ifM (liftIO $ doesFileExist $ fromRawFilePath file)
@ -44,8 +44,8 @@ lookupFile = lookupFile' catkeyfile
, catKeyFileHidden file =<< getCurrentBranch , catKeyFileHidden file =<< getCurrentBranch
) )
lookupFileNotHidden :: RawFilePath -> Annex (Maybe Key) lookupKeyNotHidden :: RawFilePath -> Annex (Maybe Key)
lookupFileNotHidden = lookupFile' catkeyfile lookupKeyNotHidden = lookupKey' catkeyfile
where where
catkeyfile file = catkeyfile file =
ifM (liftIO $ doesFileExist $ fromRawFilePath file) ifM (liftIO $ doesFileExist $ fromRawFilePath file)
@ -53,8 +53,8 @@ lookupFileNotHidden = lookupFile' catkeyfile
, return Nothing , return Nothing
) )
lookupFile' :: (RawFilePath -> Annex (Maybe Key)) -> RawFilePath -> Annex (Maybe Key) lookupKey' :: (RawFilePath -> Annex (Maybe Key)) -> RawFilePath -> Annex (Maybe Key)
lookupFile' catkeyfile file = isAnnexLink file >>= \case lookupKey' catkeyfile file = isAnnexLink file >>= \case
Just key -> return (Just key) Just key -> return (Just key)
Nothing -> catkeyfile file Nothing -> catkeyfile file
@ -64,7 +64,7 @@ whenAnnexed :: (RawFilePath -> Key -> Annex (Maybe a)) -> RawFilePath -> Annex (
whenAnnexed a file = ifAnnexed file (a file) (return Nothing) whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
ifAnnexed :: RawFilePath -> (Key -> Annex a) -> Annex a -> Annex a ifAnnexed :: RawFilePath -> (Key -> Annex a) -> Annex a -> Annex a
ifAnnexed file yes no = maybe no yes =<< lookupFile file ifAnnexed file yes no = maybe no yes =<< lookupKey file
{- Find all unlocked files and update the keys database for them. {- Find all unlocked files and update the keys database for them.
- -

View file

@ -145,7 +145,7 @@ expensiveScan urlrenderer rs = batch <~> do
(unwanted', ts) <- maybe (unwanted', ts) <- maybe
(return (unwanted, [])) (return (unwanted, []))
(findtransfers f unwanted) (findtransfers f unwanted)
=<< liftAnnex (lookupFile f) =<< liftAnnex (lookupKey f)
mapM_ (enqueue f) ts mapM_ (enqueue f) ts
{- Delay for a short time to avoid using too much CPU. -} {- Delay for a short time to avoid using too much CPU. -}

View file

@ -289,7 +289,7 @@ onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkss
onAddSymlink :: Handler onAddSymlink :: Handler
onAddSymlink file filestatus = unlessIgnored file $ do onAddSymlink file filestatus = unlessIgnored file $ do
linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file) linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
kv <- liftAnnex (lookupFile (toRawFilePath file)) kv <- liftAnnex (lookupKey (toRawFilePath file))
onAddSymlink' linktarget kv file filestatus onAddSymlink' linktarget kv file filestatus
onAddSymlink' :: Maybe String -> Maybe Key -> Handler onAddSymlink' :: Maybe String -> Maybe Key -> Handler

View file

@ -128,7 +128,7 @@ makeinfos updated version = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
liftIO $ putStrLn $ "building info files" liftIO $ putStrLn $ "building info files"
forM_ updated $ \(f, bv) -> do forM_ updated $ \(f, bv) -> do
v <- lookupFile (toRawFilePath f) v <- lookupKey (toRawFilePath f)
case v of case v of
Nothing -> noop Nothing -> noop
Just k -> whenM (inAnnex k) $ do Just k -> whenM (inAnnex k) $ do

View file

@ -49,7 +49,7 @@ withFilesInGit ww a l = seekFiltered a $
seekHelper id ww LsFiles.inRepo l seekHelper id ww LsFiles.inRepo l
withFilesInGitAnnex :: WarnUnmatchWhen -> (RawFilePath -> Key -> CommandSeek) -> [WorkTreeItem] -> CommandSeek withFilesInGitAnnex :: WarnUnmatchWhen -> (RawFilePath -> Key -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withFilesInGitAnnex ww a l = seekFiltered' a $ withFilesInGitAnnex ww a l = seekFilteredKeys a $
seekHelper fst3 ww LsFiles.inRepoDetails l seekHelper fst3 ww LsFiles.inRepoDetails l
withFilesInGitNonRecursive :: WarnUnmatchWhen -> String -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek withFilesInGitNonRecursive :: WarnUnmatchWhen -> String -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
@ -120,10 +120,6 @@ withFilesToBeCommitted :: (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> Comm
withFilesToBeCommitted a l = seekFiltered a $ withFilesToBeCommitted a l = seekFiltered a $
seekHelper id WarnUnmatchWorkTreeItems (const LsFiles.stagedNotDeleted) l seekHelper id WarnUnmatchWorkTreeItems (const LsFiles.stagedNotDeleted) l
isOldUnlocked :: RawFilePath -> Annex Bool
isOldUnlocked f = liftIO (notSymlink f) <&&>
(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
{- unlocked pointer files that are staged, and whose content has not been {- unlocked pointer files that are staged, and whose content has not been
- modified-} - modified-}
withUnmodifiedUnlockedPointers :: WarnUnmatchWhen -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek withUnmodifiedUnlockedPointers :: WarnUnmatchWhen -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
@ -268,8 +264,9 @@ seekFiltered a fs = do
process matcher f = process matcher f =
whenM (matcher $ MatchingFile $ FileInfo f f) $ a f whenM (matcher $ MatchingFile $ FileInfo f f) $ a f
seekFiltered' :: (RawFilePath -> Key -> CommandSeek) -> Annex [(RawFilePath, Git.Sha, FileMode)] -> Annex () -- This is siginificantly faster than using lookupKey after seekFiltered.
seekFiltered' a fs = do seekFilteredKeys :: (RawFilePath -> Key -> CommandSeek) -> Annex [(RawFilePath, Git.Sha, FileMode)] -> Annex ()
seekFilteredKeys a fs = do
g <- Annex.gitRepo g <- Annex.gitRepo
catObjectStream' g $ \feeder closer reader -> do catObjectStream' g $ \feeder closer reader -> do
tid <- liftIO . async =<< forkState (gofeed feeder closer) tid <- liftIO . async =<< forkState (gofeed feeder closer)

View file

@ -84,7 +84,7 @@ keyOpt s = case parseURI s of
Nothing -> giveup $ "bad key/url " ++ s Nothing -> giveup $ "bad key/url " ++ s
perform :: Key -> FilePath -> CommandPerform perform :: Key -> FilePath -> CommandPerform
perform key file = lookupFileNotHidden (toRawFilePath file) >>= \case perform key file = lookupKeyNotHidden (toRawFilePath file) >>= \case
Nothing -> ifM (liftIO $ doesFileExist file) Nothing -> ifM (liftIO $ doesFileExist file)
( hasothercontent ( hasothercontent
, do , do

View file

@ -168,7 +168,7 @@ parseJSONInput i = case eitherDecode (BU.fromString i) of
startBatch :: (Either RawFilePath Key, MetaData) -> CommandStart startBatch :: (Either RawFilePath Key, MetaData) -> CommandStart
startBatch (i, (MetaData m)) = case i of startBatch (i, (MetaData m)) = case i of
Left f -> do Left f -> do
mk <- lookupFile f mk <- lookupKey f
case mk of case mk of
Just k -> go k (mkActionItem (k, AssociatedFile (Just f))) Just k -> go k (mkActionItem (k, AssociatedFile (Just f)))
Nothing -> giveup $ "not an annexed file: " ++ fromRawFilePath f Nothing -> giveup $ "not an annexed file: " ++ fromRawFilePath f

View file

@ -136,7 +136,7 @@ send ups fs = do
let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f) $ let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f) $
liftIO $ hPutStrLn h o liftIO $ hPutStrLn h o
forM_ fs' $ \f -> do forM_ fs' $ \f -> do
mk <- lookupFile f mk <- lookupKey f
case mk of case mk of
Nothing -> noop Nothing -> noop
Just k -> withObjectLoc k $ Just k -> withObjectLoc k $

View file

@ -439,7 +439,7 @@ randKey sz = withTmpFile "randkey" $ \f h -> do
return k return k
getReadonlyKey :: Remote -> FilePath -> Annex Key getReadonlyKey :: Remote -> FilePath -> Annex Key
getReadonlyKey r f = lookupFile (toRawFilePath f) >>= \case getReadonlyKey r f = lookupKey (toRawFilePath f) >>= \case
Nothing -> giveup $ f ++ " is not an annexed file" Nothing -> giveup $ f ++ " is not an annexed file"
Just k -> do Just k -> do
unlessM (inAnnex k) $ unlessM (inAnnex k) $

View file

@ -215,7 +215,7 @@ withKeysReferenced' mdir initial a = do
Just dir -> inRepo $ LsFiles.inRepo [] [toRawFilePath dir] Just dir -> inRepo $ LsFiles.inRepo [] [toRawFilePath dir]
go v [] = return v go v [] = return v
go v (f:fs) = do go v (f:fs) = do
mk <- lookupFile f mk <- lookupKey f
case mk of case mk of
Nothing -> go v fs Nothing -> go v fs
Just k -> do Just k -> do

View file

@ -372,7 +372,7 @@ addAccessedWithin duration = do
secs = fromIntegral (durationSeconds duration) secs = fromIntegral (durationSeconds duration)
lookupFileKey :: FileInfo -> Annex (Maybe Key) lookupFileKey :: FileInfo -> Annex (Maybe Key)
lookupFileKey = lookupFile . currFile lookupFileKey = lookupKey . 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

@ -704,7 +704,7 @@ test_lock_force = intmpclonerepo $ do
git_annex "get" [annexedfile] @? "get of file failed" git_annex "get" [annexedfile] @? "get of file failed"
git_annex "unlock" [annexedfile] @? "unlock failed" git_annex "unlock" [annexedfile] @? "unlock failed"
annexeval $ do annexeval $ do
Just k <- Annex.WorkTree.lookupFile (toRawFilePath annexedfile) Just k <- Annex.WorkTree.lookupKey (toRawFilePath annexedfile)
Database.Keys.removeInodeCaches k Database.Keys.removeInodeCaches k
Database.Keys.closeDb Database.Keys.closeDb
liftIO . nukeFile =<< Annex.fromRepo Annex.Locations.gitAnnexKeysDbIndexCache liftIO . nukeFile =<< Annex.fromRepo Annex.Locations.gitAnnexKeysDbIndexCache
@ -1680,7 +1680,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 <- Annex.WorkTree.lookupFile (toRawFilePath annexedfile) Just k <- Annex.WorkTree.lookupKey (toRawFilePath 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]

View file

@ -316,7 +316,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 $ Annex.WorkTree.lookupFile (toRawFilePath f) r <- annexeval $ Annex.WorkTree.lookupKey (toRawFilePath f)
case r of case r of
Just k -> do Just k -> do
uuids <- annexeval $ Remote.keyLocations k uuids <- annexeval $ Remote.keyLocations k
@ -327,7 +327,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)
=<< Annex.WorkTree.lookupFile (toRawFilePath file) =<< Annex.WorkTree.lookupKey (toRawFilePath file)
assertEqual ("backend for " ++ file) (Just expected) b assertEqual ("backend for " ++ file) (Just expected) b
checkispointerfile :: FilePath -> Assertion checkispointerfile :: FilePath -> Assertion

View file

@ -31,8 +31,8 @@ keyFile0 :: Key -> FilePath
keyFile0 = Upgrade.V1.keyFile1 keyFile0 = Upgrade.V1.keyFile1
fileKey0 :: FilePath -> Key fileKey0 :: FilePath -> Key
fileKey0 = Upgrade.V1.fileKey1 fileKey0 = Upgrade.V1.fileKey1
lookupFile0 :: FilePath -> Annex (Maybe (Key, Backend)) lookupKey0 :: FilePath -> Annex (Maybe (Key, Backend))
lookupFile0 = Upgrade.V1.lookupFile1 lookupKey0 = Upgrade.V1.lookupKey1
getKeysPresent0 :: FilePath -> Annex [Key] getKeysPresent0 :: FilePath -> Annex [Key]
getKeysPresent0 dir = ifM (liftIO $ doesDirectoryExist dir) getKeysPresent0 dir = ifM (liftIO $ doesDirectoryExist dir)

View file

@ -90,7 +90,7 @@ updateSymlinks = do
void $ liftIO cleanup void $ liftIO cleanup
where where
fixlink f = do fixlink f = do
r <- lookupFile1 f r <- lookupKey1 f
case r of case r of
Nothing -> noop Nothing -> noop
Just (k, _) -> do Just (k, _) -> do
@ -191,8 +191,8 @@ readLog1 :: FilePath -> IO [LogLine]
readLog1 file = catchDefaultIO [] $ readLog1 file = catchDefaultIO [] $
parseLog . encodeBL <$> readFileStrict file parseLog . encodeBL <$> readFileStrict file
lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend)) lookupKey1 :: FilePath -> Annex (Maybe (Key, Backend))
lookupFile1 file = do lookupKey1 file = do
tl <- liftIO $ tryIO getsymlink tl <- liftIO $ tryIO getsymlink
case tl of case tl of
Left _ -> return Nothing Left _ -> return Nothing

View file

@ -115,7 +115,7 @@ upgradeDirectWorkTree = do
void $ liftIO clean void $ liftIO clean
where where
go (f, _sha, mode) | isSymLink mode = do go (f, _sha, mode) | isSymLink mode = do
-- Cannot use lookupFile here, as we're in between direct -- Cannot use lookupKey here, as we're in between direct
-- mode and v6. -- mode and v6.
mk <- catKeyFile f mk <- catKeyFile f
case mk of case mk of