25703e1413
Fourth or fifth try at this and finally found a way to make it work. Absurd amount of busy-work forced on me by change in cabal's behavior. Split up Utility modules that need posix stuff out of ones used by Setup. Various other hacks around inability for Setup to use anything that ifdefs a use of unix. Probably lost a full day of my life to this. This is how build systems make their users hate them. Just saying.
66 lines
1.5 KiB
Haskell
66 lines
1.5 KiB
Haskell
{- git-annex actions
|
|
-
|
|
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.Action where
|
|
|
|
import qualified Data.Map as M
|
|
#ifndef mingw32_HOST_OS
|
|
import System.Posix.Signals
|
|
import System.Posix.Process (getAnyProcessStatus)
|
|
import Utility.Exception
|
|
#endif
|
|
|
|
import Annex.Common
|
|
import qualified Annex
|
|
import Annex.Content
|
|
import Annex.CatFile
|
|
import Annex.CheckAttr
|
|
import Annex.HashObject
|
|
import Annex.CheckIgnore
|
|
|
|
{- Actions to perform each time ran. -}
|
|
startup :: Annex ()
|
|
startup =
|
|
#ifndef mingw32_HOST_OS
|
|
liftIO $ void $ installHandler sigINT Default Nothing
|
|
#else
|
|
return ()
|
|
#endif
|
|
|
|
{- Cleanup actions. -}
|
|
shutdown :: Bool -> Annex ()
|
|
shutdown nocommit = do
|
|
saveState nocommit
|
|
sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
|
|
stopCoProcesses
|
|
liftIO reapZombies -- zombies from long-running git processes
|
|
|
|
{- Stops all long-running git query processes. -}
|
|
stopCoProcesses :: Annex ()
|
|
stopCoProcesses = do
|
|
catFileStop
|
|
checkAttrStop
|
|
hashObjectStop
|
|
checkIgnoreStop
|
|
|
|
{- Reaps any zombie processes that may be hanging around.
|
|
-
|
|
- Warning: Not thread safe. Anything that was expecting to wait
|
|
- on a process and get back an exit status is going to be confused
|
|
- if this reap gets there first. -}
|
|
reapZombies :: IO ()
|
|
#ifndef mingw32_HOST_OS
|
|
reapZombies =
|
|
-- throws an exception when there are no child processes
|
|
catchDefaultIO Nothing (getAnyProcessStatus False True)
|
|
>>= maybe (return ()) (const reapZombies)
|
|
|
|
#else
|
|
reapZombies = return ()
|
|
#endif
|