6eac3112e5
I had a transfer of 3 files fail like this: git-annex: transferrer protocol error: "(recording state in git...)" The remote had stalldetection enabled, although I didn't see it stall. So git-annex transferrer would have been started up. I guess that one of these new git-annex branch reads, that happens early, caused that message due to perhaps an uncommitted git-annex branch change. Since the transferrer speaks a protocol over stdout, it needs to be prevented from outputting other messages to stdout. Interestingly, startupAnnex is run after prepRunCommand, so if a command requests quiet output it would already be quiet. But the transferrer does not, instead it calls Annex.setOutput SerializedOutput in its start action.
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 clusters to be loaded 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.
|
|
void loadClusters
|
|
|
|
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
|