Avoid leaving repo with a detached head when there is a failure checking out an updated adjusted branch

I don't know of scenarios where that can happen (besides the bug
fixed by the parent commit), but there probably are some.

Sponsored-by: Boyd Stephen Smith Jr. on Patreon

Annex/AdjustedBranch.hs

@@ -248,26 +248,42 @@ checkoutAdjustedBranch (AdjBranch b) quietcheckout = do
 updateAdjustedBranch :: Adjustment -> AdjBranch -> OrigBranch -> Annex Bool
 updateAdjustedBranch adj (AdjBranch currbranch) origbranch
 	| not (adjustmentIsStable adj) = do
-		b <- preventCommits $ \commitlck -> do
+		(b, origheadfile, newheadfile) <- preventCommits $ \commitlck -> do
 			-- Avoid losing any commits that the adjusted branch
 			-- has that have not yet been propigated back to the
 			-- origbranch.
 			_ <- propigateAdjustedCommits' origbranch adj commitlck
 				
+			origheadfile <- inRepo $ readFile . Git.Ref.headFile
+
 			-- Git normally won't do anything when asked to check
 			-- out the currently checked out branch, even when its
 			-- ref has changed. Work around this by writing a raw
 			-- sha to .git/HEAD.
-			inRepo (Git.Ref.sha currbranch) >>= \case
+			newheadfile <- inRepo (Git.Ref.sha currbranch) >>= \case
-				Just headsha -> inRepo $ \r ->
+				Just headsha -> do
-					writeFile (Git.Ref.headFile r) (fromRef headsha)
+					inRepo $ \r -> do
-				_ -> noop
+						let newheadfile = fromRef headsha
+						writeFile (Git.Ref.headFile r) newheadfile
+						return (Just newheadfile)
+				_ -> return Nothing
 	
-			adjustBranch adj origbranch
+			b <- adjustBranch adj origbranch
+			return (b, origheadfile, newheadfile)
 	
 		-- Make git checkout quiet to avoid warnings about
 		-- disconnected branch tips being lost.
-		checkoutAdjustedBranch b True
+		ok <- checkoutAdjustedBranch b True
+
+		-- Avoid leaving repo with detached head.
+		unless ok $ case newheadfile of
+			Nothing -> noop
+			Just v -> preventCommits $ \_commitlck -> inRepo $ \r -> do
+				v' <- readFile (Git.Ref.headFile r)
+				when (v == v') $
+					writeFile (Git.Ref.headFile r) origheadfile
+
+		return ok
 	| otherwise = preventCommits $ \commitlck -> do
 		-- Done for consistency.
 		_ <- propigateAdjustedCommits' origbranch adj commitlck

CHANGELOG

@@ -3,6 +3,8 @@ git-annex (10.20230322) UNRELEASED; urgency=medium
   * sync: Fix parsing of gcrypt::rsync:// urls that use a relative path.
   * Avoid failure to update adjusted branch --unlock-present after git-annex
     drop when annex.adjustedbranchrefresh=1
+  * Avoid leaving repo with a detached head when there is a failure
+    checking out an updated adjusted branch.
 
  -- Joey Hess <id@joeyh.name>  Thu, 23 Mar 2023 15:04:41 -0400
 

doc/bugs/Failed_adjusted_branch_update_after_error_in_drop.mdwn

@@ -53,4 +53,4 @@ local repository version: 8
 
 git-annex is too good. It so rarely causes problems that one does not develop the "git-annex troubleshooting muscle". :)
 
-
+> [[fixed|done]] --[[Joey]]