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.Link
import Annex.Wanted import Annex.Wanted
import Annex.CatFile import Annex.CatFile
import Annex.Action (quiesce)
import Logs.Group import Logs.Group
import Logs.Trust import Logs.Trust
import Logs.PreferredContent import Logs.PreferredContent
@ -1012,12 +1013,26 @@ updateSimRepos :: SimState SimRepo -> IO (SimState SimRepo)
updateSimRepos st = updateSimRepoStates st >>= initNewSimRepos updateSimRepos st = updateSimRepoStates st >>= initNewSimRepos
updateSimRepoStates :: SimState SimRepo -> IO (SimState SimRepo) 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 where
go st [] = return st go st [] = return st
go st ((u, rst):rest) = case simRepo rst of go st ((u, rst):rest) = case simRepo rst of
Just sr -> do Just sr -> do
sr' <- updateSimRepoState st sr sr' <- a st sr
let rst' = rst { simRepo = Just sr' } let rst' = rst { simRepo = Just sr' }
let st' = st let st' = st
{ simRepoState = M.insert u rst' { simRepoState = M.insert u rst'
@ -1278,11 +1293,11 @@ suspendSim :: SimState SimRepo -> IO ()
suspendSim st = do suspendSim st = do
-- Update the sim repos before suspending, so that at restore time -- Update the sim repos before suspending, so that at restore time
-- they are up-to-date. -- they are up-to-date.
st' <- updateSimRepos st st' <- quiesceSim =<< updateSimRepos st
let st'' = 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 where
freeze :: SimRepoState SimRepo -> SimRepoState () freeze :: SimRepoState SimRepo -> SimRepoState ()
freeze rst = rst { simRepo = Nothing } freeze rst = rst { simRepo = Nothing }

View file

@ -33,9 +33,10 @@ seek ("show":[]) = do
seek ("run":simfile:[]) = startsim' (Just simfile) >>= cleanup seek ("run":simfile:[]) = startsim' (Just simfile) >>= cleanup
where where
cleanup st = do cleanup st = do
st' <- liftIO $ quiesceSim st
endsim endsim
when (simFailed st) $ do when (simFailed st') $ do
showsim st showsim st'
giveup "Simulation shown above had errors." giveup "Simulation shown above had errors."
seek ps = case parseSimCommand ps of seek ps = case parseSimCommand ps of
Left err -> giveup err Left err -> giveup err