diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-12-27 15:59:59 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-12-27 15:59:59 -0400 |
commit | 60c88820987596809091ee010e6be2a083888bc8 (patch) | |
tree | dc2540c6deadfcf3efee1fd95948bcbd6f219db5 /Annex | |
parent | 17490f3685aee698e10555c5dc3e915a317c2250 (diff) |
annex.thin
Decided it's too scary to make v6 unlocked files have 1 copy by default,
but that should be available to those who need it. This is consistent with
git-annex not dropping unused content without --force, etc.
* Added annex.thin setting, which makes unlocked files in v6 repositories
be hard linked to their content, instead of a copy. This saves disk
space but means any modification of an unlocked file will lose the local
(and possibly only) copy of the old version.
* Enable annex.thin by default on upgrade from direct mode to v6, since
direct mode made the same tradeoff.
* fix: Adjusts unlocked files as configured by annex.thin.
Diffstat (limited to 'Annex')
-rw-r--r-- | Annex/Content.hs | 131 | ||||
-rw-r--r-- | Annex/Ingest.hs | 8 | ||||
-rw-r--r-- | Annex/ReplaceFile.hs | 2 |
3 files changed, 80 insertions, 61 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index e501df072..6c03e334c 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -25,8 +25,8 @@ module Annex.Content ( checkDiskSpace, moveAnnex, populatePointerFile, - linkAnnex, - linkAnnex', + linkToAnnex, + linkFromAnnex, LinkAnnexResult(..), unlinkAnnex, checkedCopyFile, @@ -469,13 +469,12 @@ moveAnnex key src = withObjectLoc key storeobject storedirect storeobject dest = ifM (liftIO $ doesFileExist dest) ( alreadyhave , modifyContent dest $ do + freezeContent src liftIO $ moveFile src dest fs <- Database.Keys.getAssociatedFiles key - if null fs - then freezeContent dest - else do - mapM_ (populatePointerFile key dest) fs - Database.Keys.storeInodeCaches key (dest:fs) + unless (null fs) $ do + mapM_ (populatePointerFile key dest) fs + Database.Keys.storeInodeCaches key (dest:fs) ) storeindirect = storeobject =<< calcRepo (gitAnnexLocation key) @@ -510,48 +509,52 @@ populatePointerFile k obj f = go =<< isPointerFile f where go (Just k') | k == k' = do liftIO $ nukeFile f - unlessM (linkAnnex'' k obj f) $ - liftIO $ writeFile f (formatPointer k) + ifM (linkOrCopy k obj f) + ( thawContent f + , liftIO $ writeFile f (formatPointer k) + ) go _ = return () -{- Hard links a file into .git/annex/objects/, falling back to a copy - - if necessary. Does nothing if the object file already exists. +data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop + +{- Populates the annex object file by hard linking or copying a source + - file to it. -} +linkToAnnex :: Key -> FilePath -> Maybe InodeCache -> Annex LinkAnnexResult +linkToAnnex key src srcic = do + dest <- calcRepo (gitAnnexLocation key) + modifyContent dest $ linkAnnex To key src srcic dest + +{- Makes a destination file be a link or copy from the annex object. -} +linkFromAnnex :: Key -> FilePath -> Annex LinkAnnexResult +linkFromAnnex key dest = do + src <- calcRepo (gitAnnexLocation key) + srcic <- withTSDelta (liftIO . genInodeCache src) + linkAnnex From key src srcic dest + +data FromTo = From | To + +{- Hard links or copies from or to the annex object location. + - Updates inode cache. - - - 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 - - prevent losing the content if the source file is deleted, but does not - - guard against modifications. + - Thaws the file that is not the annex object. + - When a hard link was made, this necessarily thaws + - the annex object too. So, adding an object to the annex this + - way can prevent losing the content if the source file + - is deleted, but does not guard against modifications. -} -linkAnnex :: Key -> FilePath -> Maybe InodeCache -> Annex LinkAnnexResult -linkAnnex key src srcic = do - dest <- calcRepo (gitAnnexLocation key) - modifyContent dest $ linkAnnex' key src srcic dest - -{- Hard links (or copies) src to dest, one of which should be the - - annex object. Updates inode cache for src and for dest when it's - - changed. -} -linkAnnex' :: Key -> FilePath -> Maybe InodeCache -> FilePath -> Annex LinkAnnexResult -linkAnnex' _ _ Nothing _ = return LinkAnnexFailed -linkAnnex' key src (Just srcic) dest = +linkAnnex :: FromTo -> Key -> FilePath -> Maybe InodeCache -> FilePath -> Annex LinkAnnexResult +linkAnnex _ _ _ Nothing _ = return LinkAnnexFailed +linkAnnex fromto key src (Just srcic) dest = ifM (liftIO $ doesFileExist dest) ( do Database.Keys.addInodeCaches key [srcic] return LinkAnnexNoop - , ifM (linkAnnex'' key src dest) + , ifM (linkOrCopy key src dest) ( do - thawContent dest - -- src could have changed while being copied - -- to dest - mcache <- withTSDelta (liftIO . genInodeCache src) - case mcache of - Just srcic' | compareStrong srcic srcic' -> do - destic <- withTSDelta (liftIO . genInodeCache dest) - Database.Keys.addInodeCaches key $ - catMaybes [destic, Just srcic] - return LinkAnnexOk - _ -> do - liftIO $ nukeFile dest - failed + thawContent $ case fromto of + From -> dest + To -> src + checksrcunchanged , failed ) ) @@ -559,25 +562,41 @@ linkAnnex' key src (Just srcic) dest = failed = do Database.Keys.addInodeCaches key [srcic] return LinkAnnexFailed - -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 - let copy = checkedCopyFile' key src dest s + checksrcunchanged = do + mcache <- withTSDelta (liftIO . genInodeCache src) + case mcache of + Just srcic' | compareStrong srcic srcic' -> do + destic <- withTSDelta (liftIO . genInodeCache dest) + Database.Keys.addInodeCaches key $ + catMaybes [destic, Just srcic] + return LinkAnnexOk + _ -> do + liftIO $ nukeFile dest + failed + +{- Hard links or copies src to dest. Only uses a hard link when annex.thin + - is enabled and when 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. -} +linkOrCopy :: Key -> FilePath -> FilePath -> Annex Bool +linkOrCopy key src dest = catchBoolIO $ + ifM (annexThin <$> Annex.getGitConfig) + ( hardlink + , copy =<< getstat + ) + where + hardlink = do #ifndef mingw32_HOST_OS - if linkCount s > 1 - then copy - else liftIO (createLink src dest >> return True) - `catchIO` const copy + s <- getstat + if linkCount s > 1 + then copy s + else liftIO (createLink src dest >> return True) + `catchIO` const (copy s) #else - copy + copy s #endif + copy = checkedCopyFile' key src dest + getstat = liftIO $ getFileStatus src {- Removes the annex object file for a key. Lowlevel. -} unlinkAnnex :: Key -> Annex () diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index b2eb27616..3ab7566c8 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -142,11 +142,11 @@ ingest (Just (LockedDown lockingfile source)) = withTSDelta $ \delta -> do gounlocked key (Just cache) s = do -- Remove temp directory hard link first because - -- linkAnnex falls back to copying if a file + -- linkToAnnex falls back to copying if a file -- already has a hard link. cleanCruft source cleanOldKeys (keyFilename source) key - r <- linkAnnex key (keyFilename source) (Just cache) + r <- linkToAnnex key (keyFilename source) (Just cache) case r of LinkAnnexFailed -> failure "failed to link to annex" _ -> do @@ -219,12 +219,12 @@ cleanOldKeys file newkey = do <$> Database.Keys.getAssociatedFiles key fs' <- filterM (`sameInodeCache` caches) fs case fs' of - -- If linkAnnex fails, the associated + -- If linkToAnnex fails, the associated -- file with the content is still present, -- so no need for any recovery. (f:_) -> do ic <- withTSDelta (liftIO . genInodeCache f) - void $ linkAnnex key f ic + void $ linkToAnnex key f ic _ -> lostcontent where lostcontent = logStatus key InfoMissing diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index 94d2688a1..f8c1d97a9 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -18,7 +18,7 @@ import Utility.Tmp - which it can write to, and once done the temp file is moved into place - and anything else in the temp directory is deleted. - - - The action can throw an IO exception, in which case the temp directory + - The action can throw an exception, in which case the temp directory - will be deleted, and the existing file will be preserved. - - Throws an IO exception when it was unable to replace the file. |