summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-03-07 12:43:56 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-03-07 12:43:56 -0400
commit2356a2557a65073bc61fc909a5806615129114d3 (patch)
treecb2460b15957628834403bb4f1c30c903dbf09e8
parent657f2518895dd055f083140ff644c144cbe72305 (diff)
Fix direct mode getKeysPresent false positive & also sped up direct mode unused and unannex
unused: In direct mode, files that are deleted from the work tree are no longer incorrectly detected as unused. Direct mode `git annex info` slows down a bit due to more stringent checking, but not by a lot.
-rw-r--r--Annex/Content.hs56
-rw-r--r--Annex/Init.hs2
-rw-r--r--Command/Info.hs2
-rw-r--r--Command/Uninit.hs2
-rw-r--r--Command/Unused.hs4
-rw-r--r--debian/changelog2
-rw-r--r--doc/bugs/copy_unused_and_unused_not_agreeing.mdwn2
7 files changed, 52 insertions, 18 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 740ed8bbc..9c71037de 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -24,6 +24,7 @@ module Annex.Content (
removeAnnex,
fromAnnex,
moveBad,
+ KeyLocation(..),
getKeysPresent,
saveState,
downloadUrl,
@@ -466,22 +467,33 @@ moveBad key = do
logStatus key InfoMissing
return dest
-{- List of keys whose content exists in the annex. -}
-getKeysPresent :: Annex [Key]
-getKeysPresent = do
+data KeyLocation = InAnnex | InRepository
+
+{- List of keys whose content exists in the specified location.
+
+ - InAnnex only lists keys under .git/annex/objects,
+ - while InRepository, in direct mode, also finds keys located in the
+ - work tree.
+ -
+ - Note that InRepository has to check whether direct mode files
+ - have goodContent.
+ -}
+getKeysPresent :: KeyLocation -> Annex [Key]
+getKeysPresent keyloc = do
direct <- isDirect
dir <- fromRepo gitAnnexObjectDir
- liftIO $ traverse direct (2 :: Int) dir
+ s <- getstate direct
+ liftIO $ traverse s direct (2 :: Int) dir
where
- traverse direct depth dir = do
+ traverse s direct depth dir = do
contents <- catchDefaultIO [] (dirContents dir)
if depth == 0
then do
- contents' <- filterM (present direct) contents
+ contents' <- filterM (present s direct) contents
let keys = mapMaybe (fileKey . takeFileName) contents'
continue keys []
else do
- let deeper = traverse direct (depth - 1)
+ let deeper = traverse s direct (depth - 1)
continue [] (map deeper contents)
continue keys [] = return keys
continue keys (a:as) = do
@@ -489,15 +501,31 @@ getKeysPresent = do
morekeys <- unsafeInterleaveIO a
continue (morekeys++keys) as
- {- In indirect mode, look for the key. In direct mode,
- - the inode cache file is only present when a key's content
- - is present, so can be used as a surrogate if the content
- - is not located in the annex directory. -}
- present False d = doesFileExist $ contentfile d
- present True d = doesFileExist (contentfile d ++ ".cache")
- <||> present False d
+ present _ False d = presentInAnnex d
+ present s True d = presentDirect s d <||> presentInAnnex d
+
+ presentInAnnex = doesFileExist . contentfile
contentfile d = d </> takeFileName d
+ presentDirect s d = case keyloc of
+ InAnnex -> return False
+ InRepository -> case fileKey (takeFileName d) of
+ Nothing -> return False
+ Just k -> Annex.eval s $
+ anyM (goodContent k) =<< associatedFiles k
+
+ {- In order to run Annex monad actions within unsafeInterleaveIO,
+ - the current state is taken and reused. No changes made to this
+ - state will be preserved.
+ -
+ - As an optimsation, call inodesChanged to prime the state with
+ - a cached value that will be used in the call to goodContent.
+ -}
+ getstate direct = do
+ when direct $
+ void $ inodesChanged
+ Annex.getState id
+
{- Things to do to record changes to content when shutting down.
-
- It's acceptable to avoid committing changes to the branch,
diff --git a/Annex/Init.hs b/Annex/Init.hs
index 57379535d..e095aef61 100644
--- a/Annex/Init.hs
+++ b/Annex/Init.hs
@@ -198,7 +198,7 @@ enableDirectMode = unlessM isDirect $ do
-}
fixBadBare :: Annex ()
fixBadBare = whenM checkBadBare $ do
- ks <- getKeysPresent
+ ks <- getKeysPresent InAnnex
liftIO $ debugM "Init" $ unwords
[ "Detected bad bare repository with"
, show (length ks)
diff --git a/Command/Info.hs b/Command/Info.hs
index f27fdfb1d..11ed98cd9 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -281,7 +281,7 @@ cachedPresentData = do
case presentData s of
Just v -> return v
Nothing -> do
- v <- foldKeys <$> lift getKeysPresent
+ v <- foldKeys <$> lift (getKeysPresent InRepository)
put s { presentData = Just v }
return v
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index 1c8d08689..2a9e3e687 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -53,7 +53,7 @@ finish :: Annex ()
finish = do
annexdir <- fromRepo gitAnnexDir
annexobjectdir <- fromRepo gitAnnexObjectDir
- leftovers <- removeUnannexed =<< getKeysPresent
+ leftovers <- removeUnannexed =<< getKeysPresent InAnnex
if null leftovers
then liftIO $ removeDirectoryRecursive annexdir
else error $ unlines
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 6b4475568..c174cd256 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -71,7 +71,9 @@ checkUnused = chain 0
return []
findunused False = do
showAction "checking for unused data"
- excludeReferenced =<< getKeysPresent
+ -- InAnnex, not InRepository because if a direct mode
+ -- file exists, it is obviously not unused.
+ excludeReferenced =<< getKeysPresent InAnnex
chain _ [] = next $ return True
chain v (a:as) = do
v' <- a v
diff --git a/debian/changelog b/debian/changelog
index b33f4c9cd..26153c5fd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,8 @@ git-annex (5.20140307) UNRELEASED; urgency=medium
* Fix zombie leak and general inneficiency when copying files to a
local git repo.
* webapp: Added a "Sync now" item to each repository's menu.
+ * unused: In direct mode, files that are deleted from the work tree
+ are no longer incorrectly detected as unused.
-- Joey Hess <joeyh@debian.org> Thu, 06 Mar 2014 16:17:01 -0400
diff --git a/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn b/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn
index 68328ac96..3790a0edf 100644
--- a/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn
+++ b/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn
@@ -46,3 +46,5 @@ copy SHA256E-s293288--30f1367fc326f7b053012818863151206f9e3ddeab3c3fc5b5c1c573d1
copy SHA256E-s3672986--be960f6dc247df2496f634f7d788bd4a180fe556230e2dafc23ebc8fc1f10af3.JPG (checking synology...) ok
$
"""]]
+
+> [[fixed|done]] per my comment --[[Joey]]