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
+{- Check if a file contains the unmodified content of the key.
- - the key. The expensive way to tell is to do a verification of its content.
+ -
+ - 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 ()
+isUnmodified :: Key -> FilePath -> Annex Bool
-resetPointerFile key f = go =<< geti
+isUnmodified key f = go =<< geti
   where
-	go Nothing = noop
+	go Nothing = return False
-	go (Just fc) = ifM (cheapcheck fc <||> expensivecheck fc)
+	go (Just fc) = 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
-		)
 	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
+seek ps = ifM versionSupportsUnlockedPointers
-	withFilesUnlocked start ps
+	( withFilesInGit (whenAnnexed startNew) ps
-	withFilesUnlockedToBeCommitted start ps
+	, do
+		withFilesUnlocked startOld ps
+		withFilesUnlockedToBeCommitted startOld ps
+	)
 
-start :: FilePath -> CommandStart
+startNew :: FilePath -> Key -> CommandStart
-start file = do
+startNew file key = do
 	showStart "lock" file
-	unlessM (Annex.getState Annex.force) $
+	go =<< isPointerFile file
-		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)"
+  where
-	next $ perform file
+	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
+performNew :: FilePath -> Key -> Bool -> CommandPerform
-perform file = do
+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
+  unlock will stage a pointer file, and will link the content of the object
-  out of .git/annex/objects to the work tree file. (Might want a --hardlink
+  from .git/annex/objects to the work tree file.
-  switch.)
   
   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.