migrate and rekey v6 unlocked file support

Annex/Content.hs

@@ -30,6 +30,8 @@ module Annex.Content (
 	LinkAnnexResult(..),
 	unlinkAnnex,
 	checkedCopyFile,
+	linkOrCopy,
+	linkOrCopy',
 	sendAnnex,
 	prepSendAnnex,
 	removeAnnex,
@@ -582,11 +584,14 @@ linkAnnex fromto key src (Just srcic) dest = do
 
 {- Hard links or copies src to dest. Only uses a hard link when annex.thin
  - is enabled and when src is not already hardlinked to elsewhere.
- - Checks disk reserve before copying, and will fail if not enough space,
- - or if the dest file already exists. -}
+ - Checks disk reserve before copying against the size of the key,
+ - and will fail if not enough space, or if the dest file already exists. -}
 linkOrCopy :: Key -> FilePath -> FilePath -> Annex Bool
-linkOrCopy key src dest = catchBoolIO $
-	ifM (annexThin <$> Annex.getGitConfig)
+linkOrCopy = linkOrCopy' (annexThin <$> Annex.getGitConfig)
+
+linkOrCopy' :: Annex Bool -> Key -> FilePath -> FilePath -> Annex Bool
+linkOrCopy' canhardlink key src dest = catchBoolIO $
+	ifM canhardlink
 		( hardlink
 		, copy =<< getstat
 		)

Command/Migrate.hs

@@ -74,9 +74,12 @@ perform file oldkey oldbackend newbackend = go =<< genkey
 		| knowngoodcontent = finish newkey
 		| otherwise = stopUnless checkcontent $ finish newkey
 	checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked $ Just file
-	finish newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $ do
-		copyMetaData oldkey newkey
-		next $ Command.ReKey.cleanup file oldkey newkey
+	finish newkey = ifM (Command.ReKey.linkKey file oldkey newkey)
+		( do
+			copyMetaData oldkey newkey
+			next $ Command.ReKey.cleanup file oldkey newkey
+		, error "failed"
+		)
 	genkey = case maybe Nothing (\fm -> fm oldkey newbackend (Just file)) (fastMigrate oldbackend) of
 		Just newkey -> return $ Just (newkey, True)
 		Nothing -> do

Command/ReKey.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -13,10 +13,16 @@ import qualified Annex
 import Types.Key
 import Annex.Content
 import Annex.Ingest
+import Annex.Link
+import Annex.Perms
+import Annex.ReplaceFile
 import Logs.Web
 import Logs.Location
-import Utility.CopyFile
+import Git.FilePath
 import qualified Remote
+import qualified Database.Keys
+import Annex.InodeSentinal
+import Utility.InodeCache
 
 cmd :: Command
 cmd = notDirect $ 
@@ -40,24 +46,50 @@ start (file, keyname) = ifAnnexed file go stop
 
 perform :: FilePath -> Key -> Key -> CommandPerform
 perform file oldkey newkey = do
-	present <- inAnnex oldkey
-	_ <- if present
-		then linkKey oldkey newkey
-		else do
-			unlessM (Annex.getState Annex.force) $
-				error $ file ++ " is not available (use --force to override)"
-			return True
+	ifM (inAnnex oldkey) 
+		( unlessM (linkKey file oldkey newkey) $
+			error "failed"
+		, unlessM (Annex.getState Annex.force) $
+			error $ file ++ " is not available (use --force to override)"
+		)
 	next $ cleanup file oldkey newkey
 
 {- Make a hard link to the old key content (when supported),
  - to avoid wasting disk space. -}
-linkKey :: Key -> Key -> Annex Bool
-linkKey oldkey newkey = getViaTmp' DefaultVerify newkey $ \tmp -> unVerified $ do
-	src <- calcRepo $ gitAnnexLocation oldkey
-	liftIO $ ifM (doesFileExist tmp)
-		( return True
-		, createLinkOrCopy src tmp
-		)
+linkKey :: FilePath -> Key -> Key -> Annex Bool
+linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
+ 	{- If the object file is already hardlinked to elsewhere, a hard
+	 - link won't be made by getViaTmp', but a copy instead.
+	 - This avoids hard linking to content linked to an
+	 - unlocked file, which would leave the new key unlocked
+	 - and vulnerable to corruption. -}
+	( getViaTmp' DefaultVerify newkey $ \tmp -> unVerified $ do
+		oldobj <- calcRepo (gitAnnexLocation oldkey)
+		linkOrCopy' (return True) newkey oldobj tmp
+	, do
+		ic <- withTSDelta (liftIO . genInodeCache file)
+	 	{- The file being rekeyed is itself an unlocked file, so if
+		 - it's linked to the old key, that link must be broken. -}
+		oldobj <- calcRepo (gitAnnexLocation oldkey)
+		v <- tryNonAsync $ modifyContent oldobj $ do
+			replaceFile oldobj $ \tmp ->
+				unlessM (checkedCopyFile oldkey file tmp) $
+					error "can't lock old key"
+			freezeContent oldobj
+			oldic <- withTSDelta (liftIO . genInodeCache oldobj)
+			whenM (isUnmodified oldkey oldobj) $
+				Database.Keys.addInodeCaches oldkey (catMaybes [oldic])
+		case v of
+			Left e -> do
+				warning (show e)
+				return False
+			Right () -> do
+				r <- linkToAnnex newkey file ic
+				return $ case r of
+					LinkAnnexFailed -> False
+					LinkAnnexOk -> True
+					LinkAnnexNoop -> True
+	)
 
 cleanup :: FilePath -> Key -> Key -> CommandCleanup
 cleanup file oldkey newkey = do
@@ -68,8 +100,18 @@ cleanup file oldkey newkey = do
 		r <- Remote.claimingUrl url
 		setUrlPresent (Remote.uuid r) newkey url
 
-	-- Update symlink to use the new key.
-	liftIO $ removeFile file
-	addLink file newkey Nothing
+	ifM (isJust <$> isAnnexLink file)
+		( do
+			-- Update symlink to use the new key.
+			liftIO $ removeFile file
+			addLink file newkey Nothing
+		, do
+			liftIO $ whenM (isJust <$> isPointerFile file) $
+				writeFile file (formatPointer newkey)
+			stagePointerFile file =<< hashPointerFile newkey
+			Database.Keys.removeAssociatedFile oldkey 
+				=<< inRepo (toTopFilePath file)
+		)
+
 	logStatus newkey InfoPresent
 	return True