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:
parent
540bd5e1ab
commit
8047128591
2 changed files with 23 additions and 7 deletions
25
Annex/Sim.hs
25
Annex/Sim.hs
|
@ -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 }
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue