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.

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
 
-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

Command/Lock.hs

@@ -79,7 +79,7 @@ performNew file key filemodified = do
 		unlessM (sameInodeCache obj (maybeToList mfc)) $ do
 			modifyContent obj $ replaceFile obj $ \tmp -> do
 				unlessM (checkedCopyFile key obj tmp) $
-					error "unable to lock file; need more free disk space"
+					error "unable to lock file"
 			Database.Keys.storeInodeCaches key [obj]
 
 	-- Try to repopulate obj from an unmodified associated file.

Command/PreCommit.hs

@@ -52,7 +52,7 @@ seek ps = lockPreCommitHook $ ifM isDirect
 			, do
 				-- fix symlinks to files being committed
 				flip withFilesToBeCommitted ps $ \f -> 
-					maybe stop (Command.Fix.start f)
+					maybe stop (Command.Fix.start Command.Fix.FixSymlinks f)
 						=<< isAnnexLink f
 				-- inject unlocked files into the annex
 				-- (not needed when repo version uses

Command/Smudge.hs

@@ -100,7 +100,7 @@ ingestLocal file = do
 	-- Hard link (or copy) file content to annex object
 	-- to prevent it from being lost when git checks out
 	-- a branch not containing this file.
-	r <- linkAnnex k file ic
+	r <- linkToAnnex k file ic
 	case r of
 		LinkAnnexFailed -> error "Problem adding file to the annex"
 		LinkAnnexOk -> logStatus k InfoPresent

Command/Unlock.hs

@@ -14,8 +14,6 @@ import Annex.CatFile
 import Annex.Version
 import Annex.Link
 import Annex.ReplaceFile
-import Annex.InodeSentinal
-import Utility.InodeCache
 import Utility.CopyFile
 
 cmd :: Command
@@ -52,13 +50,11 @@ start file key = ifM (isJust <$> isAnnexLink file)
 
 performNew :: FilePath -> Key -> CommandPerform
 performNew dest key = do
-	src <- calcRepo (gitAnnexLocation key)
-	srcic <- withTSDelta (liftIO . genInodeCache src)
 	replaceFile dest $ \tmp -> do
-		r <- linkAnnex' key src srcic tmp
+		r <- linkFromAnnex key tmp
 		case r of
 			LinkAnnexOk -> return ()
-			_ -> error "linkAnnex failed"
+			_ -> error "unlock failed"
 	next $ cleanupNew dest key
 
 cleanupNew ::  FilePath -> Key -> CommandCleanup