From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 24 Sep 2024 20:46:09 +0000 (-0400)
Subject: sim: quiesce before freezing or ending
X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~21^2~25^2~8
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=804712859114c8fce93971faab7ab3be76421fa3;p=git-annex.git

sim: quiesce before freezing or ending

Probably a good idea for freezing, but especially I hope this fixes a
problem with git-annex sim run that caused it to sometimes crash in
removeDirectoryRecursive with directory not empty, presumably because a
thread was writing there at the same time.
---

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index 42c3b8d437..dfae56949b 100644
--- a/Annex/Sim.hs
+++ b/Annex/Sim.hs
@@ -26,6 +26,7 @@ import Annex.Startup
 import Annex.Link
 import Annex.Wanted
 import Annex.CatFile
+import Annex.Action (quiesce)
 import Logs.Group
 import Logs.Trust
 import Logs.PreferredContent
@@ -1012,12 +1013,26 @@ updateSimRepos :: SimState SimRepo -> IO (SimState SimRepo)
 updateSimRepos st = updateSimRepoStates st >>= initNewSimRepos
 
 updateSimRepoStates :: SimState SimRepo -> IO (SimState SimRepo)
-updateSimRepoStates inst = go inst (M.toList $ simRepoState inst)
+updateSimRepoStates = overSimRepoStates updateSimRepoState
+
+quiesceSim :: SimState SimRepo -> IO (SimState SimRepo)
+quiesceSim = overSimRepoStates go
+  where
+	go st sr = do
+		((), astrd) <- Annex.run (simRepoAnnex sr) $ doQuietAction $
+			quiesce False
+		return $ sr
+			{ simRepoAnnex = astrd
+			, simRepoCurrState = st
+			}
+
+overSimRepoStates :: (SimState SimRepo -> SimRepo -> IO SimRepo) -> SimState SimRepo -> IO (SimState SimRepo)
+overSimRepoStates a inst = go inst (M.toList $ simRepoState inst)
   where
 	go st [] = return st
 	go st ((u, rst):rest) = case simRepo rst of
 		Just sr -> do
-			sr' <- updateSimRepoState st sr
+			sr' <- a st sr
 			let rst' = rst { simRepo = Just sr' }
 			let st' = st
 				{ simRepoState = M.insert u rst'
@@ -1278,11 +1293,11 @@ suspendSim :: SimState SimRepo -> IO ()
 suspendSim st = do
 	-- Update the sim repos before suspending, so that at restore time
 	-- they are up-to-date.
-	st' <- updateSimRepos st
+	st' <- quiesceSim =<< updateSimRepos st
 	let st'' = st'
-		{ simRepoState = M.map freeze (simRepoState st)
+		{ simRepoState = M.map freeze (simRepoState st')
 		}
-	writeFile (simRootDirectory st </> "state") (show st'')
+	writeFile (simRootDirectory st'' </> "state") (show st'')
   where
 	freeze :: SimRepoState SimRepo -> SimRepoState ()
 	freeze rst = rst { simRepo = Nothing }
diff --git a/Command/Sim.hs b/Command/Sim.hs
index f14142b069..93ae309ab6 100644
--- a/Command/Sim.hs
+++ b/Command/Sim.hs
@@ -33,9 +33,10 @@ seek ("show":[]) = do
 seek ("run":simfile:[]) = startsim' (Just simfile) >>= cleanup
   where
 	cleanup st = do 
+		st' <- liftIO $ quiesceSim st
 		endsim
-		when (simFailed st) $ do
-			showsim st
+		when (simFailed st') $ do
+			showsim st'
 			giveup "Simulation shown above had errors."
 seek ps = case parseSimCommand ps of
 	Left err -> giveup err