aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/AutoMerge.hs3
-rw-r--r--Annex/Content.hs8
-rw-r--r--Annex/Drop.hs3
-rw-r--r--Annex/Ingest.hs26
-rw-r--r--Assistant/Threads/Watcher.hs12
-rw-r--r--Command/Lock.hs7
-rw-r--r--Command/Smudge.hs3
-rw-r--r--Command/Unannex.hs3
-rw-r--r--Database/Keys.hs26
-rw-r--r--Git/FilePath.hs3
-rw-r--r--Upgrade/V5.hs4
11 files changed, 60 insertions, 38 deletions
diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs
index 462e87e09..162ea66bc 100644
--- a/Annex/AutoMerge.hs
+++ b/Annex/AutoMerge.hs
@@ -24,6 +24,7 @@ import qualified Git.Ref
import qualified Git
import qualified Git.Branch
import Git.Types (BlobType(..))
+import Git.FilePath
import Config
import Annex.ReplaceFile
import Annex.VariantFile
@@ -188,7 +189,7 @@ resolveMerge' unstagedmap (Just us) them u = do
writeFile dest (formatPointer key)
_ -> noop
stagePointerFile dest =<< hashPointerFile key
- Database.Keys.addAssociatedFile key dest
+ Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest)
{- Stage a graft of a directory or file from a branch.
-
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 2a8b295d3..9e8da49e9 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -65,6 +65,7 @@ import Utility.DataUnits
import Utility.CopyFile
import Utility.Metered
import Config
+import Git.FilePath
import Git.SharedRepository
import Annex.Perms
import Annex.Link
@@ -471,7 +472,9 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
, modifyContent dest $ do
freezeContent src
liftIO $ moveFile src dest
- fs <- Database.Keys.getAssociatedFiles key
+ g <- Annex.gitRepo
+ fs <- map (`fromTopFilePath` g)
+ <$> Database.Keys.getAssociatedFiles key
unless (null fs) $ do
mapM_ (populatePointerFile key dest) fs
Database.Keys.storeInodeCaches key (dest:fs)
@@ -722,7 +725,8 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key remove removedirect
remove file = cleanObjectLoc key $ do
secureErase file
liftIO $ nukeFile file
- mapM_ (void . tryIO . resetpointer)
+ g <- Annex.gitRepo
+ mapM_ (\f -> void $ tryIO $ resetpointer $ fromTopFilePath f g)
=<< Database.Keys.getAssociatedFiles key
Database.Keys.removeInodeCaches key
Direct.removeInodeCache key
diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index 7e494c374..f02f4f386 100644
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -19,6 +19,7 @@ import Annex.Wanted
import Config
import Annex.Content.Direct
import qualified Database.Keys
+import Git.FilePath
import qualified Data.Set as S
import System.Log.Logger (debugM)
@@ -49,7 +50,7 @@ handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile
handleDropsFrom locs rs reason fromhere key afile preverified runner = do
l <- ifM isDirect
( associatedFilesRelative key
- , Database.Keys.getAssociatedFiles key
+ , mapM getTopFilePath <$> Database.Keys.getAssociatedFiles key
)
let fs = if null l then maybeToList afile else l
n <- getcopies fs
diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs
index 3ab7566c8..73f8a39ca 100644
--- a/Annex/Ingest.hs
+++ b/Annex/Ingest.hs
@@ -37,6 +37,7 @@ import Utility.InodeCache
import Annex.ReplaceFile
import Utility.Tmp
import Utility.CopyFile
+import Git.FilePath
import Annex.InodeSentinal
#ifdef WITH_CLIBS
#ifndef __ANDROID__
@@ -186,15 +187,18 @@ finishIngestUnlocked key source = do
finishIngestUnlocked' :: Key -> KeySource -> Annex ()
finishIngestUnlocked' key source = do
- Database.Keys.addAssociatedFile key (keyFilename source)
+ Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath (keyFilename source))
populateAssociatedFiles key source
{- Copy to any other locations using the same key. -}
populateAssociatedFiles :: Key -> KeySource -> Annex ()
populateAssociatedFiles key source = do
- otherfs <- filter (/= keyFilename source) <$> Database.Keys.getAssociatedFiles key
obj <- calcRepo (gitAnnexLocation key)
- forM_ otherfs $
+ g <- Annex.gitRepo
+ ingestedf <- flip fromTopFilePath g
+ <$> inRepo (toTopFilePath (keyFilename source))
+ afs <- map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key
+ forM_ (filter (/= ingestedf) afs) $
populatePointerFile key obj
cleanCruft :: KeySource -> Annex ()
@@ -206,16 +210,18 @@ cleanCruft source = when (contentLocation source /= keyFilename source) $
-- content. Clean up from that.
cleanOldKeys :: FilePath -> Key -> Annex ()
cleanOldKeys file newkey = do
+ g <- Annex.gitRepo
+ ingestedf <- flip fromTopFilePath g <$> inRepo (toTopFilePath file)
+ topf <- inRepo (toTopFilePath file)
oldkeys <- filter (/= newkey)
- <$> Database.Keys.getAssociatedKey file
- mapM_ go oldkeys
- where
- go key = do
+ <$> Database.Keys.getAssociatedKey topf
+ forM_ oldkeys $ \key -> do
obj <- calcRepo (gitAnnexLocation key)
caches <- Database.Keys.getInodeCaches key
unlessM (sameInodeCache obj caches) $ do
unlinkAnnex key
- fs <- filter (/= file)
+ fs <- filter (/= ingestedf)
+ . map (`fromTopFilePath` g)
<$> Database.Keys.getAssociatedFiles key
fs' <- filterM (`sameInodeCache` caches) fs
case fs' of
@@ -225,9 +231,7 @@ cleanOldKeys file newkey = do
(f:_) -> do
ic <- withTSDelta (liftIO . genInodeCache f)
void $ linkToAnnex key f ic
- _ -> lostcontent
- where
- lostcontent = logStatus key InfoMissing
+ _ -> logStatus key InfoMissing
{- On error, put the file back so it doesn't seem to have vanished.
- This can be called before or after the symlink is in place. -}
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index bb9659b7c..d10f929d0 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -41,6 +41,7 @@ import Annex.ReplaceFile
import Annex.Version
import Annex.InodeSentinal
import Git.Types
+import Git.FilePath
import Config
import Utility.ThreadScheduler
import Logs.Location
@@ -225,8 +226,11 @@ shouldRestage :: DaemonStatus -> Bool
shouldRestage ds = scanComplete ds || forceRestage ds
onAddUnlocked :: Bool -> FileMatcher Annex -> Handler
-onAddUnlocked = onAddUnlocked' False contentchanged Database.Keys.addAssociatedFile samefilestatus
+onAddUnlocked = onAddUnlocked' False contentchanged addassociatedfile samefilestatus
where
+ addassociatedfile key file =
+ Database.Keys.addAssociatedFile key
+ =<< inRepo (toTopFilePath file)
samefilestatus key file status = do
cache <- Database.Keys.getInodeCaches key
curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta file status
@@ -235,7 +239,8 @@ onAddUnlocked = onAddUnlocked' False contentchanged Database.Keys.addAssociatedF
([], Nothing) -> return True
_ -> return False
contentchanged oldkey file = do
- Database.Keys.removeAssociatedFile oldkey file
+ Database.Keys.removeAssociatedFile oldkey
+ =<< inRepo (toTopFilePath file)
unlessM (inAnnex oldkey) $
logStatus oldkey InfoMissing
@@ -356,8 +361,9 @@ onDel file _ = do
onDel' :: FilePath -> Annex ()
onDel' file = do
+ topfile <- inRepo (toTopFilePath file)
ifM versionSupportsUnlockedPointers
- ( withkey $ flip Database.Keys.removeAssociatedFile file
+ ( withkey $ flip Database.Keys.removeAssociatedFile topfile
, whenM isDirect $
withkey $ \key -> void $ removeAssociatedFile key file
)
diff --git a/Command/Lock.hs b/Command/Lock.hs
index e4039dd8b..8b36e1cee 100644
--- a/Command/Lock.hs
+++ b/Command/Lock.hs
@@ -21,6 +21,7 @@ import Utility.InodeCache
import qualified Database.Keys
import Annex.Ingest
import Logs.Location
+import Git.FilePath
cmd :: Command
cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
@@ -85,7 +86,9 @@ performNew file key filemodified = do
-- Try to repopulate obj from an unmodified associated file.
repopulate obj
| filemodified = modifyContent obj $ do
- fs <- Database.Keys.getAssociatedFiles key
+ g <- Annex.gitRepo
+ fs <- mapM (`fromTopFilePath` g)
+ <$> Database.Keys.getAssociatedFiles key
mfile <- firstM (isUnmodified key) fs
liftIO $ nukeFile obj
case mfile of
@@ -99,7 +102,7 @@ performNew file key filemodified = do
cleanupNew :: FilePath -> Key -> CommandCleanup
cleanupNew file key = do
- Database.Keys.removeAssociatedFile key file
+ Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)
return True
startOld :: FilePath -> CommandStart
diff --git a/Command/Smudge.hs b/Command/Smudge.hs
index 43033ee15..8b7d848d2 100644
--- a/Command/Smudge.hs
+++ b/Command/Smudge.hs
@@ -15,6 +15,7 @@ import Annex.FileMatcher
import Annex.Ingest
import Logs.Location
import qualified Database.Keys
+import Git.FilePath
import qualified Data.ByteString.Lazy as B
@@ -58,7 +59,7 @@ smudge file = do
=<< catchMaybeIO (B.readFile content)
, liftIO $ B.putStr b
)
- Database.Keys.addAssociatedFile k file
+ Database.Keys.addAssociatedFile k =<< inRepo (toTopFilePath file)
stop
-- Clean filter is fed file content on stdin, decides if a file
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index 9bde19106..317fd5856 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -23,6 +23,7 @@ import qualified Git.DiffTree as DiffTree
import Utility.CopyFile
import Command.PreCommit (lockPreCommitHook)
import qualified Database.Keys
+import Git.FilePath
cmd :: Command
cmd = withGlobalOptions annexedMatchingOptions $
@@ -87,7 +88,7 @@ performIndirect file key = do
cleanupIndirect :: FilePath -> Key -> CommandCleanup
cleanupIndirect file key = do
- Database.Keys.removeAssociatedFile key file
+ Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)
src <- calcRepo $ gitAnnexLocation key
ifM (Annex.getState Annex.fast)
( do
diff --git a/Database/Keys.hs b/Database/Keys.hs
index aeb71ecde..8cea5c940 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -165,50 +165,50 @@ openDb createdb _ = withExclusiveLock gitAnnexKeysDbLock $ do
where
open db = liftIO $ DbOpen <$> H.openDbQueue db "content"
-addAssociatedFile :: Key -> FilePath -> Annex ()
+addAssociatedFile :: Key -> TopFilePath -> Annex ()
addAssociatedFile k f = runWriter $ addAssociatedFile' k f
-addAssociatedFile' :: Key -> FilePath -> Writer
+addAssociatedFile' :: Key -> TopFilePath -> Writer
addAssociatedFile' k f = queueDb $ do
-- If the same file was associated with a different key before,
-- remove that.
delete $ from $ \r -> do
- where_ (r ^. AssociatedFile ==. val f &&. r ^. AssociatedKey ==. val sk)
- void $ insertUnique $ Associated sk f
+ where_ (r ^. AssociatedFile ==. val (getTopFilePath f) &&. r ^. AssociatedKey ==. val sk)
+ void $ insertUnique $ Associated sk (getTopFilePath f)
where
sk = toSKey k
{- Note that the files returned were once associated with the key, but
- some of them may not be any longer. -}
-getAssociatedFiles :: Key -> Annex [FilePath]
+getAssociatedFiles :: Key -> Annex [TopFilePath]
getAssociatedFiles = runReader . getAssociatedFiles' . toSKey
-getAssociatedFiles' :: SKey -> Reader [FilePath]
+getAssociatedFiles' :: SKey -> Reader [TopFilePath]
getAssociatedFiles' sk = readDb $ do
l <- select $ from $ \r -> do
where_ (r ^. AssociatedKey ==. val sk)
return (r ^. AssociatedFile)
- return $ map unValue l
+ return $ map (TopFilePath . unValue) l
{- Gets any keys that are on record as having a particular associated file.
- (Should be one or none but the database doesn't enforce that.) -}
-getAssociatedKey :: FilePath -> Annex [Key]
+getAssociatedKey :: TopFilePath -> Annex [Key]
getAssociatedKey = runReader . getAssociatedKey'
-getAssociatedKey' :: FilePath -> Reader [Key]
+getAssociatedKey' :: TopFilePath -> Reader [Key]
getAssociatedKey' f = readDb $ do
l <- select $ from $ \r -> do
- where_ (r ^. AssociatedFile ==. val f)
+ where_ (r ^. AssociatedFile ==. val (getTopFilePath f))
return (r ^. AssociatedKey)
return $ map (fromSKey . unValue) l
-removeAssociatedFile :: Key -> FilePath -> Annex ()
+removeAssociatedFile :: Key -> TopFilePath -> Annex ()
removeAssociatedFile k = runWriter . removeAssociatedFile' (toSKey k)
-removeAssociatedFile' :: SKey -> FilePath -> Writer
+removeAssociatedFile' :: SKey -> TopFilePath -> Writer
removeAssociatedFile' sk f = queueDb $
delete $ from $ \r -> do
- where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f)
+ where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val (getTopFilePath f))
{- Find all unlocked associated files. This is expensive, and so normally
- the associated files are updated incrementally when changes are noticed. -}
diff --git a/Git/FilePath.hs b/Git/FilePath.hs
index edc3c0f90..7e7d86bb4 100644
--- a/Git/FilePath.hs
+++ b/Git/FilePath.hs
@@ -13,9 +13,8 @@
{-# LANGUAGE CPP #-}
module Git.FilePath (
- TopFilePath,
+ TopFilePath(..),
fromTopFilePath,
- getTopFilePath,
toTopFilePath,
asTopFilePath,
InternalGitPath,
diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs
index 8e567b425..369188fb8 100644
--- a/Upgrade/V5.hs
+++ b/Upgrade/V5.hs
@@ -20,6 +20,7 @@ import qualified Annex.Content.Direct as Direct
import qualified Git
import qualified Git.LsFiles
import qualified Git.Branch
+import Git.FilePath
import Git.FileMode
import Git.Config
import Utility.InodeCache
@@ -89,7 +90,8 @@ upgradeDirectWorkTree = do
, fromdirect f k
)
stagePointerFile f =<< hashPointerFile k
- Database.Keys.addAssociatedFile k f
+ Database.Keys.addAssociatedFile k
+ =<< inRepo (toTopFilePath f)
return ()
go _ = noop
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 15:48:17 +0000