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.
This commit is contained in:
parent
bb6719678e
commit
121f5d5b0c
17 changed files with 259 additions and 146 deletions
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2010 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
@ -11,7 +11,13 @@ module Command.Fix where
|
|||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import Config
|
||||
import qualified Annex
|
||||
import Annex.Version
|
||||
import Annex.ReplaceFile
|
||||
import Annex.Content
|
||||
import qualified Annex.Queue
|
||||
import qualified Database.Keys
|
||||
#ifdef WITH_CLIBS
|
||||
#ifndef __ANDROID__
|
||||
import Utility.Touch
|
||||
|
@ -21,22 +27,66 @@ import Utility.Touch
|
|||
cmd :: Command
|
||||
cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $
|
||||
command "fix" SectionMaintenance
|
||||
"fix up symlinks to point to annexed content"
|
||||
"fix up links to annexed content"
|
||||
paramPaths (withParams seek)
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek = withFilesInGit $ whenAnnexed start
|
||||
seek ps = unlessM crippledFileSystem $ do
|
||||
fixwhat <- ifM versionSupportsUnlockedPointers
|
||||
( return FixAll
|
||||
, return FixSymlinks
|
||||
)
|
||||
flip withFilesInGit ps $ whenAnnexed $ start fixwhat
|
||||
|
||||
{- Fixes the symlink to an annexed file. -}
|
||||
start :: FilePath -> Key -> CommandStart
|
||||
start file key = do
|
||||
link <- calcRepo $ gitAnnexLink file key
|
||||
stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do
|
||||
data FixWhat = FixSymlinks | FixAll
|
||||
|
||||
start :: FixWhat -> FilePath -> Key -> CommandStart
|
||||
start fixwhat file key = do
|
||||
currlink <- liftIO $ catchMaybeIO $ readSymbolicLink file
|
||||
wantlink <- calcRepo $ gitAnnexLink file key
|
||||
case currlink of
|
||||
Just l
|
||||
| l /= wantlink -> fixby $ fixSymlink file wantlink
|
||||
| otherwise -> stop
|
||||
Nothing -> case fixwhat of
|
||||
FixAll -> fixthin
|
||||
FixSymlinks -> stop
|
||||
where
|
||||
fixby a = do
|
||||
showStart "fix" file
|
||||
next $ perform file link
|
||||
next a
|
||||
fixthin = do
|
||||
obj <- calcRepo $ gitAnnexLocation key
|
||||
stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do
|
||||
thin <- annexThin <$> Annex.getGitConfig
|
||||
fs <- liftIO $ catchMaybeIO $ getFileStatus file
|
||||
os <- liftIO $ catchMaybeIO $ getFileStatus obj
|
||||
case (linkCount <$> fs, linkCount <$> os, thin) of
|
||||
(Just 1, Just 1, True) ->
|
||||
fixby $ makeHardLink file key
|
||||
(Just n, Just n', False) | n > 1 && n == n' ->
|
||||
fixby $ breakHardLink file key obj
|
||||
_ -> stop
|
||||
|
||||
perform :: FilePath -> FilePath -> CommandPerform
|
||||
perform file link = do
|
||||
breakHardLink :: FilePath -> Key -> FilePath -> CommandPerform
|
||||
breakHardLink file key obj = do
|
||||
replaceFile file $ \tmp ->
|
||||
unlessM (checkedCopyFile key obj tmp) $
|
||||
error "unable to break hard link"
|
||||
Database.Keys.storeInodeCaches key [file]
|
||||
next $ return True
|
||||
|
||||
makeHardLink :: FilePath -> Key -> CommandPerform
|
||||
makeHardLink file key = do
|
||||
replaceFile file $ \tmp -> do
|
||||
r <- linkFromAnnex key tmp
|
||||
case r of
|
||||
LinkAnnexFailed -> error "unable to make hard link"
|
||||
_ -> noop
|
||||
next $ return True
|
||||
|
||||
fixSymlink :: FilePath -> FilePath -> CommandPerform
|
||||
fixSymlink file link = do
|
||||
liftIO $ do
|
||||
#ifdef WITH_CLIBS
|
||||
#ifndef __ANDROID__
|
||||
|
@ -53,9 +103,9 @@ perform file link = do
|
|||
maybe noop (\t -> touch file t False) mtime
|
||||
#endif
|
||||
#endif
|
||||
next $ cleanup file
|
||||
next $ cleanupSymlink file
|
||||
|
||||
cleanup :: FilePath -> CommandCleanup
|
||||
cleanup file = do
|
||||
cleanupSymlink :: FilePath -> CommandCleanup
|
||||
cleanupSymlink file = do
|
||||
Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file]
|
||||
return True
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue