From de92739546ba6fd82963e9932d622b891f8ff096 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 7 Jan 2016 14:51:28 -0400
Subject: migrate and rekey v6 unlocked file support

---
 Command/Migrate.hs |  9 ++++--
 Command/ReKey.hs   | 80 +++++++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 67 insertions(+), 22 deletions(-)

(limited to 'Command')

diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index ad3a5efa1..87e4772d1 100644
--- a/Command/Migrate.hs
+++ b/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
diff --git a/Command/ReKey.hs b/Command/ReKey.hs
index 9fb8515c0..468d0dfe6 100644
--- a/Command/ReKey.hs
+++ b/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
-- 
cgit v1.2.3