v6 git-annex unlock

Note that the implementation uses replaceFile, so that the actual
replacement of the work tree file is atomic. This seems a good property to
have!

It would be possible for unlock in v6 mode to be run on files that do not
have their content present. However, that would be a behavior change from
before, and I don't see any immediate need to support it, so I didn't
implement it.

1 files changed, 42 insertions, 8 deletions

diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index d1b1d0e90..1cfd4a0b2 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.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,9 @@ import Common.Annex
 import Command
 import Annex.Content
 import Annex.CatFile
+import Annex.Version
+import Annex.Link
+import Annex.ReplaceFile
 import Utility.CopyFile
 
 cmd :: Command
@@ -26,14 +29,45 @@ mkcmd n d = notDirect $ withGlobalOptions annexedMatchingOptions $
 seek :: CmdParams -> CommandSeek
 seek = withFilesInGit $ whenAnnexed start
 
-{- The unlock subcommand replaces the symlink with a copy of the file's
- - content. -}
+{- Before v6, the unlock subcommand replaces the symlink with a copy of
+ - the file's content. In v6 and above, it converts the file from a symlink
+ - to a pointer. -}
 start :: FilePath -> Key -> CommandStart
-start file key = do
-	showStart "unlock" file
+start file key = ifM (isJust <$> isAnnexLink file)
+	( do
+		showStart "unlock" file
+		ifM (inAnnex key)
+			( ifM versionSupportsUnlockedPointers
+				( next $ performNew file key
+				, startOld file key 
+				)
+			, do
+				warning "content not present; cannot unlock"
+				next $ next $ return False
+			)
+	, stop
+	)
+
+performNew :: FilePath -> Key -> CommandPerform
+performNew dest key = do
+	src <- calcRepo (gitAnnexLocation key)
+	replaceFile dest $ \tmp -> do
+		r <- linkAnnex' key src tmp
+		case r of
+			LinkAnnexOk -> return ()
+			_ -> error "linkAnnex failed"
+	next $ cleanupNew dest key
+
+cleanupNew ::  FilePath -> Key -> CommandCleanup
+cleanupNew dest key = do
+	stagePointerFile dest =<< hashPointerFile key
+	return True
+
+startOld :: FilePath -> Key -> CommandStart
+startOld file key = 
 	ifM (inAnnex key)
 		( ifM (isJust <$> catKeyFileHEAD file)
-			( next $ perform file key
+			( next $ performOld file key
 			, do
 				warning "this has not yet been committed to git; cannot unlock it"
 				next $ next $ return False
@@ -43,8 +77,8 @@ start file key = do
 			next $ next $ return False
 		)
 
-perform :: FilePath -> Key -> CommandPerform
-perform dest key = ifM (checkDiskSpace Nothing key 0 True)
+performOld :: FilePath -> Key -> CommandPerform
+performOld dest key = ifM (checkDiskSpace Nothing key 0 True)
 	( do
 		src <- calcRepo $ gitAnnexLocation key
 		tmpdest <- fromRepo $ gitAnnexTmpObjectLocation key