3a1f39fbdf
This fixes a problem with datalad's test suite, where loading the cluster log happened to cause the git-annex branch commits to take a different shape, with an additional commit. It's also faster though, since many commands don't need the cluster log. Just fill Annex.clusters with a thunk. Sponsored-by: the NIH-funded NICEMAN (ReproNim TR&D3) project
67 lines
1.7 KiB
Haskell
67 lines
1.7 KiB
Haskell
{- git-annex startup
|
|
-
|
|
- Copyright 2010-2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.Startup where
|
|
|
|
import Annex.Common
|
|
import qualified Annex
|
|
import Logs.Cluster
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
import Control.Concurrent.STM
|
|
import System.Posix.Signals
|
|
#endif
|
|
|
|
{- Run when starting up the main git-annex program. -}
|
|
startup :: Annex ()
|
|
startup = do
|
|
startupSignals
|
|
gc <- Annex.getGitConfig
|
|
when (isinitialized gc)
|
|
startupAnnex
|
|
where
|
|
isinitialized gc = annexUUID gc /= NoUUID
|
|
&& isJust (annexVersion gc)
|
|
|
|
{- Run when starting up the main git-annex program when
|
|
- git-annex has already been initialized.
|
|
- Alternatively, run after initialization.
|
|
-}
|
|
startupAnnex :: Annex ()
|
|
startupAnnex = doQuietAction $
|
|
-- Logs.Location needs this before it is used, in order for a
|
|
-- cluster to be treated as the location of keys
|
|
-- that are located in any of its nodes.
|
|
preLoadClusters
|
|
|
|
startupSignals :: Annex ()
|
|
startupSignals = do
|
|
#ifndef mingw32_HOST_OS
|
|
av <- Annex.getRead Annex.signalactions
|
|
let propagate sig = liftIO $ installhandleronce sig av
|
|
propagate sigINT
|
|
propagate sigQUIT
|
|
propagate sigTERM
|
|
propagate sigTSTP
|
|
propagate sigCONT
|
|
propagate sigHUP
|
|
-- sigWINCH is not propagated; it should not be needed,
|
|
-- and the concurrent-output library installs its own signal
|
|
-- handler for it.
|
|
-- sigSTOP and sigKILL cannot be caught, so will not be propagated.
|
|
where
|
|
installhandleronce sig av = void $
|
|
installHandler sig (CatchOnce (gotsignal sig av)) Nothing
|
|
gotsignal sig av = do
|
|
mapM_ (\a -> a (fromIntegral sig)) =<< atomically (readTVar av)
|
|
raiseSignal sig
|
|
installhandleronce sig av
|
|
#else
|
|
return ()
|
|
#endif
|