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.
This commit is contained in:
Joey Hess 2024-09-24 16:46:09 -04:00
parent 540bd5e1ab
commit 8047128591
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 23 additions and 7 deletions

View file

@ -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 }

View file

@ -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