only make 1 hardlink max between pointer file and annex object
If multiple files point to the same annex object, the user may want to modify them independently, so don't use a hard link. Also, check diskreserve when copying.
This commit is contained in:
parent
c608a752a5
commit
50e83b606c
3 changed files with 40 additions and 14 deletions
|
@ -72,11 +72,12 @@ import Messages.Progress
|
||||||
import qualified Types.Remote
|
import qualified Types.Remote
|
||||||
import qualified Types.Backend
|
import qualified Types.Backend
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
|
import qualified Database.Keys
|
||||||
import Types.NumCopies
|
import Types.NumCopies
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Annex.InodeSentinal
|
import Annex.InodeSentinal
|
||||||
import Utility.InodeCache
|
import Utility.InodeCache
|
||||||
import qualified Database.Keys
|
import Utility.PosixFiles
|
||||||
|
|
||||||
{- Checks if a given key's content is currently present. -}
|
{- Checks if a given key's content is currently present. -}
|
||||||
inAnnex :: Key -> Annex Bool
|
inAnnex :: Key -> Annex Bool
|
||||||
|
@ -389,7 +390,7 @@ withTmp key action = do
|
||||||
return res
|
return res
|
||||||
|
|
||||||
{- Checks that there is disk space available to store a given key,
|
{- Checks that there is disk space available to store a given key,
|
||||||
- in a destination (or the annex) printing a warning if not.
|
- in a destination directory (or the annex) printing a warning if not.
|
||||||
-
|
-
|
||||||
- If the destination is on the same filesystem as the annex,
|
- If the destination is on the same filesystem as the annex,
|
||||||
- checks for any other running downloads, removing the amount of data still
|
- checks for any other running downloads, removing the amount of data still
|
||||||
|
@ -397,7 +398,12 @@ withTmp key action = do
|
||||||
- when doing concurrent downloads.
|
- when doing concurrent downloads.
|
||||||
-}
|
-}
|
||||||
checkDiskSpace :: Maybe FilePath -> Key -> Integer -> Bool -> Annex Bool
|
checkDiskSpace :: Maybe FilePath -> Key -> Integer -> Bool -> Annex Bool
|
||||||
checkDiskSpace destdir key alreadythere samefilesystem = ifM (Annex.getState Annex.force)
|
checkDiskSpace destdir key = checkDiskSpace' (fromMaybe 1 (keySize key)) destdir key
|
||||||
|
|
||||||
|
{- Allows specifying the size of the key, if it's known, which is useful
|
||||||
|
- as not all keys know their size. -}
|
||||||
|
checkDiskSpace' :: Integer -> Maybe FilePath -> Key -> Integer -> Bool -> Annex Bool
|
||||||
|
checkDiskSpace' need destdir key alreadythere samefilesystem = ifM (Annex.getState Annex.force)
|
||||||
( return True
|
( return True
|
||||||
, do
|
, do
|
||||||
-- We can't get inprogress and free at the same
|
-- We can't get inprogress and free at the same
|
||||||
|
@ -410,8 +416,8 @@ checkDiskSpace destdir key alreadythere samefilesystem = ifM (Annex.getState Ann
|
||||||
then sizeOfDownloadsInProgress (/= key)
|
then sizeOfDownloadsInProgress (/= key)
|
||||||
else pure 0
|
else pure 0
|
||||||
free <- liftIO . getDiskFree =<< dir
|
free <- liftIO . getDiskFree =<< dir
|
||||||
case (free, fromMaybe 1 (keySize key)) of
|
case free of
|
||||||
(Just have, need) -> do
|
Just have -> do
|
||||||
reserve <- annexDiskReserve <$> Annex.getGitConfig
|
reserve <- annexDiskReserve <$> Annex.getGitConfig
|
||||||
let delta = need + reserve - have - alreadythere + inprogress
|
let delta = need + reserve - have - alreadythere + inprogress
|
||||||
let ok = delta <= 0
|
let ok = delta <= 0
|
||||||
|
@ -499,14 +505,15 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
|
||||||
populatePointerFile :: Key -> FilePath -> FilePath -> Annex ()
|
populatePointerFile :: Key -> FilePath -> FilePath -> Annex ()
|
||||||
populatePointerFile k obj f = go =<< isPointerFile f
|
populatePointerFile k obj f = go =<< isPointerFile f
|
||||||
where
|
where
|
||||||
go (Just k') | k == k' = liftIO $ do
|
go (Just k') | k == k' = do
|
||||||
nukeFile f
|
liftIO $ nukeFile f
|
||||||
unlessM (catchBoolIO $ createLinkOrCopy obj f) $
|
unlessM (linkAnnex'' k obj f) $
|
||||||
writeFile f (formatPointer k)
|
liftIO $ writeFile f (formatPointer k)
|
||||||
go _ = return ()
|
go _ = return ()
|
||||||
|
|
||||||
|
|
||||||
{- Hard links a file into .git/annex/objects/, falling back to a copy
|
{- Hard links a file into .git/annex/objects/, falling back to a copy
|
||||||
- if necessary.
|
- if necessary. Does nothing if the object file already exists.
|
||||||
-
|
-
|
||||||
- Does not lock down the hard linked object, so that the user can modify
|
- Does not lock down the hard linked object, so that the user can modify
|
||||||
- the source file. So, adding an object to the annex this way can
|
- the source file. So, adding an object to the annex this way can
|
||||||
|
@ -524,7 +531,7 @@ linkAnnex' :: Key -> FilePath -> FilePath -> Annex LinkAnnexResult
|
||||||
linkAnnex' key src dest =
|
linkAnnex' key src dest =
|
||||||
ifM (liftIO $ doesFileExist dest)
|
ifM (liftIO $ doesFileExist dest)
|
||||||
( return LinkAnnexNoop
|
( return LinkAnnexNoop
|
||||||
, ifM (liftIO $ createLinkOrCopy src dest)
|
, ifM (linkAnnex'' key src dest)
|
||||||
( do
|
( do
|
||||||
thawContent dest
|
thawContent dest
|
||||||
Database.Keys.storeInodeCaches key [dest, src]
|
Database.Keys.storeInodeCaches key [dest, src]
|
||||||
|
@ -535,6 +542,27 @@ linkAnnex' key src dest =
|
||||||
|
|
||||||
data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop
|
data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop
|
||||||
|
|
||||||
|
{- Hard links or copies src to dest. Only uses a hard link if src
|
||||||
|
- is not already hardlinked to elsewhere. Checks disk reserve before
|
||||||
|
- copying, and will fail if not enough space, or if the dest file
|
||||||
|
- already exists. -}
|
||||||
|
linkAnnex'' :: Key -> FilePath -> FilePath -> Annex Bool
|
||||||
|
linkAnnex'' key src dest = catchBoolIO $ do
|
||||||
|
s <- liftIO $ getFileStatus src
|
||||||
|
#ifndef mingw32_HOST_OS
|
||||||
|
if linkCount s > 1
|
||||||
|
then copy s
|
||||||
|
else liftIO (createLink src dest >> return True)
|
||||||
|
`catchIO` const (copy s)
|
||||||
|
#else
|
||||||
|
copy s
|
||||||
|
#endif
|
||||||
|
where
|
||||||
|
copy s = ifM (checkDiskSpace' (fromIntegral $ fileSize s) (Just $ takeDirectory dest) key 0 True)
|
||||||
|
( liftIO $ copyFileExternal CopyAllMetaData src dest
|
||||||
|
, return False
|
||||||
|
)
|
||||||
|
|
||||||
{- Runs an action to transfer an object's content.
|
{- Runs an action to transfer an object's content.
|
||||||
-
|
-
|
||||||
- In some cases, it's possible for the file to change as it's being sent.
|
- In some cases, it's possible for the file to change as it's being sent.
|
||||||
|
|
|
@ -86,7 +86,7 @@ ingest file = do
|
||||||
}
|
}
|
||||||
k <- fst . fromMaybe (error "failed to generate a key")
|
k <- fst . fromMaybe (error "failed to generate a key")
|
||||||
<$> genKey source backend
|
<$> genKey source backend
|
||||||
-- Hard link (or copy) file content to annex
|
-- Hard link (or copy) file content to annex object
|
||||||
-- to prevent it from being lost when git checks out
|
-- to prevent it from being lost when git checks out
|
||||||
-- a branch not containing this file.
|
-- a branch not containing this file.
|
||||||
r <- linkAnnex k file
|
r <- linkAnnex k file
|
||||||
|
|
|
@ -327,8 +327,6 @@ files to be unlocked, while the indirect upgrades don't touch the files.
|
||||||
* Dropping a smudged file causes git status to show it as modified,
|
* Dropping a smudged file causes git status to show it as modified,
|
||||||
because the timestamp has changed. Avoid this by preserving timestamp
|
because the timestamp has changed. Avoid this by preserving timestamp
|
||||||
of smudged files when manipulating.
|
of smudged files when manipulating.
|
||||||
* linkAnnex should check disk reserve when it falls back to copying the
|
|
||||||
file.
|
|
||||||
* Reconcile staged changes into the associated files database, whenever
|
* Reconcile staged changes into the associated files database, whenever
|
||||||
the database is queried.
|
the database is queried.
|
||||||
* See if the cases where the Keys database is not used can be
|
* See if the cases where the Keys database is not used can be
|
||||||
|
|
Loading…
Add table
Reference in a new issue