import Common.Annex
import qualified Annex
import Annex.Content
+import qualified Database.Keys
{- Actions to perform each time ran. -}
startup :: Annex ()
shutdown nocommit = do
saveState nocommit
sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
+ Database.Keys.shutdown
liftIO reapZombies -- zombies from long-running git processes
fs <- Database.Keys.getAssociatedFiles key
if null fs
then freezeContent dest
- else mapM_ (populatePointerFile key dest) fs
+ else do
+ mapM_ (populatePointerFile key dest) fs
+ Database.Keys.storeInodeCaches key (dest:fs)
)
storeindirect = storeobject =<< calcRepo (gitAnnexLocation key)
( return LinkAnnexNoop
, modifyContent dest $
ifM (liftIO $ createLinkOrCopy src dest)
- ( return LinkAnnexOk
+ ( do
+ Database.Keys.storeInodeCaches key [dest, src]
+ return LinkAnnexOk
, return LinkAnnexFailed
)
)
removeInodeCache key
mapM_ (void . tryIO . resetPointerFile key)
=<< Database.Keys.getAssociatedFiles key
+ Database.Keys.removeInodeCaches key
removedirect fs = do
cache <- recordedInodeCache key
removeInodeCache key
{- To safely reset a pointer file, it has to be the unmodified content of
- the key. The expensive way to tell is to do a verification of its content.
- The cheaper way is to see if the InodeCache for the key matches the
- - file.
- -}
+ - file. -}
resetPointerFile :: Key -> FilePath -> Annex ()
resetPointerFile key f = go =<< geti
where
secureErase f
liftIO $ nukeFile f
liftIO $ writeFile f (formatPointer key)
- , noop
+ -- Can't delete the pointer file.
+ -- If it was a hard link to the annex object,
+ -- that object might have been frozen as part of the
+ -- removal process, so thaw it.
+ , thawContent f
)
- cheapcheck fc = maybe (return False) (compareInodeCaches fc)
- =<< Database.Keys.getInodeCache key
+ cheapcheck fc = anyM (compareInodeCaches fc)
+ =<< Database.Keys.getInodeCaches key
expensivecheck fc = ifM (verifyKeyContent AlwaysVerify Types.Remote.UnVerified key f)
-- The file could have been modified while it was
-- being verified. Detect that.
case parseLinkOrPointer b of
Nothing -> liftIO $ B.putStr b
Just k -> do
- updateAssociatedFiles k file
+ Database.Keys.addAssociatedFile k file
content <- calcRepo (gitAnnexLocation k)
liftIO $ B.hPut stdout . fromMaybe b
=<< catchMaybeIO (B.readFile content)
else ifM (shouldAnnex file)
( do
k <- ingest file
- updateAssociatedFiles k file
+ Database.Keys.addAssociatedFile k file
liftIO $ emitPointer k
, liftIO $ B.hPut stdout b
)
emitPointer :: Key -> IO ()
emitPointer = putStrLn . formatPointer
-
-updateAssociatedFiles :: Key -> FilePath -> Annex ()
-updateAssociatedFiles k f = do
- Database.Keys.addAssociatedFile k f
- Database.Keys.flushDb
module Database.Keys (
DbHandle,
openDb,
- flushDb,
closeDb,
+ shutdown,
addAssociatedFile,
getAssociatedFiles,
removeAssociatedFile,
- setInodeCache,
- getInodeCache,
+ storeInodeCaches,
+ addInodeCaches,
+ getInodeCaches,
+ removeInodeCaches,
AssociatedId,
- DataId,
+ ContentId,
) where
import Database.Types
import Annex.LockFile
import Messages
import Utility.InodeCache
+import Annex.InodeSentinal
import Database.Persist.TH
import Database.Esqueleto hiding (Key)
key SKey
file FilePath
KeyFileIndex key file
-Data
+Content
key SKey
- inodeCache SInodeCache
- KeyIndex key
+ cache SInodeCache
+ KeyCacheIndex key cache
|]
{- Opens the database, creating it if it doesn't exist yet. -}
runMigrationSilent migrateKeysDb
setAnnexDirPerm dbdir
setAnnexFilePerm db
- h <- liftIO $ H.openDb db "data"
+ h <- liftIO $ H.openDb db "content"
-- work around https://github.com/yesodweb/persistent/issues/474
liftIO setConsoleEncoding
Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h }
return h
-{- Flushes any changes made to the database. -}
-flushDb :: Annex ()
-flushDb = withDbHandle H.flushQueueDb
+shutdown :: Annex ()
+shutdown = maybe noop go =<< Annex.getState Annex.keysdbhandle
+ where
+ go h = do
+ Annex.changeState $ \s -> s { Annex.keysdbhandle = Nothing }
+ liftIO $ closeDb h
addAssociatedFile :: Key -> FilePath -> Annex ()
addAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $ do
return $ map unValue l
removeAssociatedFile :: Key -> FilePath -> Annex ()
-removeAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
+removeAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
delete $ from $ \r -> do
where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f)
where
sk = toSKey k
-setInodeCache :: Key -> InodeCache -> Annex ()
-setInodeCache k i = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
- void $ upsert (Data (toSKey k) (toSInodeCache i)) []
+{- Stats the files, and stores their InodeCaches. -}
+storeInodeCaches :: Key -> [FilePath] -> Annex ()
+storeInodeCaches k fs = withTSDelta $ \d ->
+ addInodeCaches k . catMaybes =<< liftIO (mapM (`genInodeCache` d) fs)
+
+addInodeCaches :: Key -> [InodeCache] -> Annex ()
+addInodeCaches k is = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
+ forM_ is $ \i -> insertUnique $ Content (toSKey k) (toSInodeCache i)
-getInodeCache :: Key -> Annex (Maybe (InodeCache))
-getInodeCache k = withDbHandle $ \h -> H.queryDb h $ do
+{- A key may have multiple InodeCaches; one for the annex object, and one
+ - for each pointer file that is a copy of it. -}
+getInodeCaches :: Key -> Annex [InodeCache]
+getInodeCaches k = withDbHandle $ \h -> H.queryDb h $ do
l <- select $ from $ \r -> do
- where_ (r ^. DataKey ==. val sk)
- return (r ^. DataInodeCache)
- return $ headMaybe $ map (fromSInodeCache . unValue) l
+ where_ (r ^. ContentKey ==. val sk)
+ return (r ^. ContentCache)
+ return $ map (fromSInodeCache . unValue) l
+ where
+ sk = toSKey k
+
+removeInodeCaches :: Key -> Annex ()
+removeInodeCaches k = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
+ delete $ from $ \r -> do
+ where_ (r ^. ContentKey ==. val sk)
where
sk = toSKey k
{- Caching a file's inode, size, and modification time
- to see when it's changed.
-
- - Copyright 2013, 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2014 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
* inAnnex check should fail in the case where an annexed object is unlocked
and has had its content changed. Could use an InodeCache for
such objects. This parallels how inAnnex checks work for direct mode.
+* Also, Annex.Content.prepSendAnnex should check the InodeCache for
+ changes.
* Reconcile staged changes into the associated files database, whenever
the database is queried.
* See if the cases where the associated files database is not used can be
(when not in direct mode).
However, beware over-optimisation breaking the assistant or perhaps other
long-lived processes.
-* Update pointer files when dropping the content of a key.
- - Check the associated files database to find associated files for the key.
- - Verify that worktree files are not modified from the annexed object.
- How? InodeCache could be maintained, but the smudge filer interface
- wouldn't let it be updated when smudging a file. May need to take
- an expensive path:
- 1. stat object file
- 2. stat worktree file
- 3. if same stat, ok else hash worktree file
- 4. stat worktree file again after checking hash; make sure it's
- unchanged from earlier stat
* Convert `git annex unlock` to stage a pointer file, and hard link to the
annexed object (or write pointer file if annexed object not present).
- Also needs to thaw annex object file
projects / git-annex.git / commitdiff