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.

1 files changed, 64 insertions, 14 deletions

diff --git a/Command/Fix.hs b/Command/Fix.hs
index abaedb30b..4a8f25493 100644
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -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
+
+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
 
-perform :: FilePath -> FilePath -> CommandPerform
-perform file link = do
+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