wip

Annex/Content.hs

@@ -41,6 +41,7 @@ module Annex.Content (
 	dirKeys,
 	withObjectLoc,
 	staleKeysPrune,
+	isUnmodified,
 ) where
 
 import System.IO.Unsafe (unsafeInterleaveIO)
@@ -634,10 +635,21 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key remove removedirect
 	remove file = cleanObjectLoc key $ do
 		secureErase file
 		liftIO $ nukeFile file
-		mapM_ (void . tryIO . resetPointerFile key)
+		mapM_ (void . tryIO . resetpointer)
 			=<< Database.Keys.getAssociatedFiles key
 		Database.Keys.removeInodeCaches key
 		Direct.removeInodeCache key
+	resetpointer file = ifM (isUnmodified key file)
+		( do
+			secureErase file
+			liftIO $ nukeFile file
+			liftIO $ writeFile file (formatPointer key)	
+		-- Can't delete the pointer file.
+		-- If it was a hard link to the annex object,
+		-- that object might have been frozen as part of the
+		-- removal process, so thaw it.
+		, void $ tryIO $ thawContent file
+		)
 	removedirect fs = do
 		cache <- Direct.recordedInodeCache key
 		Direct.removeInodeCache key
@@ -647,25 +659,16 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key remove removedirect
 		secureErase f
 		replaceFile f $ makeAnnexLink l
 
-{- To safely reset a pointer file, it has to be the unmodified content of
- - the key. The expensive way to tell is to do a verification of its content.
+{- Check if a file contains the unmodified content of the key.
+ -
+ - The expensive way to tell is to do a verification of its content.
  - The cheaper way is to see if the InodeCache for the key matches the
  - file. -}
-resetPointerFile :: Key -> FilePath -> Annex ()
-resetPointerFile key f = go =<< geti
+isUnmodified :: Key -> FilePath -> Annex Bool
+isUnmodified key f = go =<< geti
   where
-	go Nothing = noop
-	go (Just fc) = ifM (cheapcheck fc <||> expensivecheck fc)
-		( do
-			secureErase f
-			liftIO $ nukeFile f
-			liftIO $ writeFile f (formatPointer key)
-		-- Can't delete the pointer file.
-		-- If it was a hard link to the annex object,
-		-- that object might have been frozen as part of the
-		-- removal process, so thaw it.
-		, thawContent f
-		)
+	go Nothing = return False
+	go (Just fc) = cheapcheck fc <||> expensivecheck fc
 	cheapcheck fc = anyM (compareInodeCaches fc)
 		=<< Database.Keys.getInodeCaches key
 	expensivecheck fc = ifM (verifyKeyContent AlwaysVerify Types.Remote.UnVerified key f)

Command/Lock.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,6 +11,13 @@ import Common.Annex
 import Command
 import qualified Annex.Queue
 import qualified Annex
+import Annex.Version
+import Annex.Content
+import Annex.Link
+import Annex.InodeSentinal
+import Utility.InodeCache
+import qualified Database.Keys
+import qualified Command.Add
 	
 cmd :: Command
 cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
@@ -19,18 +26,77 @@ cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
 		paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = do
-	withFilesUnlocked start ps
-	withFilesUnlockedToBeCommitted start ps
+seek ps = ifM versionSupportsUnlockedPointers
+	( withFilesInGit (whenAnnexed startNew) ps
+	, do
+		withFilesUnlocked startOld ps
+		withFilesUnlockedToBeCommitted startOld ps
+	)
 
-start :: FilePath -> CommandStart
-start file = do
+startNew :: FilePath -> Key -> CommandStart
+startNew file key = do
 	showStart "lock" file
-	unlessM (Annex.getState Annex.force) $
-		error "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"
-	next $ perform file
+	go =<< isPointerFile file
+  where
+	go (Just key')
+		| key' == key = cont False
+		| otherwise = errorModified
+	go Nothing = 
+		ifM (isUnmodified key file) 
+			( cont False
+			, ifM (Annex.getState Annex.force)
+				( cont True
+				, errorModified
+				)
+			)
+	cont = next . performNew file key
 
-perform :: FilePath -> CommandPerform
-perform file = do
+performNew :: FilePath -> Key -> Bool -> CommandPerform
+performNew file key filemodified = do
+	-- If other files use this same key, and are unlocked, 
+	-- the annex object file might be hard linked to those files.
+	-- It's also possible that the annex object file was
+	-- modified while the file was unlocked. 
+	--
+	-- So, in order to lock the file's content, we need to break all
+	-- hard links to the annex object file, and if it's modified,
+	-- replace it with a copy of the content of one of the associated
+	-- files.
+	--
+	-- When the file being locked is unmodified, the annex object file
+	-- can just be linked to it. (Which might already be the case, but
+	-- do it again to be sure.)
+	--
+	-- When the file being locked is modified, find another associated
+	-- file that is unmodified, and copy it to the annex object file.
+	-- If there are no unmodified associated files, the content of
+	-- the key is lost.
+	--
+	-- If the filesystem doesn't support hard links, none of this
+	-- is a concern.
+	obj <- calcRepo (gitAnnexLocation key)
+
+	freezeContent obj
+	Command.Add.addLink file key
+		=<< withTSDelta (liftIO . genInodeCache file)
+	next $ cleanupNew file key
+
+cleanupNew :: FilePath -> Key -> CommandCleanup
+cleanupNew file key = do
+	Database.Keys.removeAssociatedFile key file
+	return True
+
+startOld :: FilePath -> CommandStart
+startOld file = do
+	showStart "lock" file
+	unlessM (Annex.getState Annex.force)
+		errorModified
+	next $ performOld file
+
+performOld :: FilePath -> CommandPerform
+performOld file = do
 	Annex.Queue.addCommand "checkout" [Param "--"] [file]
-	next $ return True -- no cleanup needed
+	next $ return True
+
+errorModified :: a
+errorModified =  error "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"

doc/todo/smudge.mdwn

@@ -233,9 +233,8 @@ git annex lock/unlock:
   transition repositories to using pointers, and a cleaner unlock/lock
   for repos using symlinks.
 
-  unlock will stage a pointer file, and will copy the content of the object
-  out of .git/annex/objects to the work tree file. (Might want a --hardlink
-  switch.)
+  unlock will stage a pointer file, and will link the content of the object
+  from .git/annex/objects to the work tree file.
   
   lock will replace the current work tree file with the symlink, and stage it.
   Note that multiple work tree files could point to the same object.