add NetWatcher thread
This deals with interruptions in network connectevity, by listening for a new network interface coming up (using dbus to see when network-manager or wicd do it), and forcing a rescan of
This commit is contained in:
parent
e3e8d32924
commit
5a68acb521
4 changed files with 190 additions and 17 deletions
150
Assistant/Threads/NetWatcher.hs
Normal file
150
Assistant/Threads/NetWatcher.hs
Normal file
|
@ -0,0 +1,150 @@
|
|||
{- git-annex assistant network connection watcher, using dbus
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Assistant.Threads.NetWatcher where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.ThreadedMonad
|
||||
import Assistant.DaemonStatus
|
||||
import Assistant.ScanRemotes
|
||||
import Assistant.Threads.Pusher (pushToRemotes)
|
||||
import Assistant.Alert
|
||||
import qualified Git
|
||||
import Utility.ThreadScheduler
|
||||
import Remote.List
|
||||
import qualified Types.Remote as Remote
|
||||
import Assistant.Threads.Merger
|
||||
import qualified Git.Branch
|
||||
|
||||
import qualified Control.Exception as E
|
||||
import Data.Time.Clock
|
||||
|
||||
#if WITH_DBUS
|
||||
import Utility.DBus
|
||||
import DBus.Client
|
||||
import DBus
|
||||
import Data.Word (Word32)
|
||||
#else
|
||||
#warning Building without dbus support; will poll for network connection changes
|
||||
#endif
|
||||
|
||||
thisThread :: ThreadName
|
||||
thisThread = "NetWatcher"
|
||||
|
||||
netWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
|
||||
netWatcherThread st handle scanremotes =
|
||||
#if WITH_DBUS
|
||||
dbusThread st handle scanremotes
|
||||
#else
|
||||
pollingThread st handle scanremotes
|
||||
#endif
|
||||
|
||||
#if WITH_DBUS
|
||||
|
||||
dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
|
||||
dbusThread st dstatus scanremotes = E.catch (go =<< connectSystem) onerr
|
||||
where
|
||||
go client = ifM (checkNetMonitor client)
|
||||
( do
|
||||
listenNMConnections client handle
|
||||
listenWicdConnections client handle
|
||||
, do
|
||||
runThreadState st $
|
||||
warning "No known network monitor available through dbus; falling back to polling"
|
||||
pollinstead
|
||||
)
|
||||
onerr :: E.SomeException -> IO ()
|
||||
onerr e = do
|
||||
runThreadState st $
|
||||
warning $ "Failed to use dbus; falling back to polling (" ++ show e ++ ")"
|
||||
pollinstead
|
||||
pollinstead = pollingThread st dstatus scanremotes
|
||||
handle = do
|
||||
debug thisThread ["detected network connection"]
|
||||
handleConnection st dstatus scanremotes
|
||||
|
||||
{- Examine the list of services connected to dbus, to see if there
|
||||
- are any we can use to monitor network connections. -}
|
||||
checkNetMonitor :: Client -> IO Bool
|
||||
checkNetMonitor client = do
|
||||
running <- filter (`elem` [networkmanager, wicd])
|
||||
<$> listServiceNames client
|
||||
case running of
|
||||
[] -> return False
|
||||
(service:_) -> do
|
||||
debug thisThread [ "Using running DBUS service"
|
||||
, service
|
||||
, "to monitor network connection events."
|
||||
]
|
||||
return True
|
||||
where
|
||||
networkmanager = "org.freedesktop.NetworkManager"
|
||||
wicd = "org.wicd.daemon"
|
||||
|
||||
{- Listens for new NetworkManager connections. -}
|
||||
listenNMConnections :: Client -> IO () -> IO ()
|
||||
listenNMConnections client callback =
|
||||
listen client matcher $ \event ->
|
||||
when (Just True == anyM activeconnection (signalBody event)) $
|
||||
callback
|
||||
where
|
||||
matcher = matchAny
|
||||
{ matchInterface = Just "org.freedesktop.NetworkManager.Connection.Active"
|
||||
, matchMember = Just "PropertiesChanged"
|
||||
}
|
||||
nm_connection_activated = toVariant (2 :: Word32)
|
||||
nm_state_key = toVariant ("State" :: String)
|
||||
activeconnection v = do
|
||||
m <- fromVariant v
|
||||
vstate <- lookup nm_state_key $ dictionaryItems m
|
||||
state <- fromVariant vstate
|
||||
return $ state == nm_connection_activated
|
||||
|
||||
{- Listens for new Wicd connections. -}
|
||||
listenWicdConnections :: Client -> IO () -> IO ()
|
||||
listenWicdConnections client callback =
|
||||
listen client matcher $ \event ->
|
||||
when (any (== wicd_success) (signalBody event)) $
|
||||
callback
|
||||
where
|
||||
matcher = matchAny
|
||||
{ matchInterface = Just "org.wicd.daemon"
|
||||
, matchMember = Just "ConnectResultsSent"
|
||||
}
|
||||
wicd_success = toVariant ("success" :: String)
|
||||
|
||||
#endif
|
||||
|
||||
pollingThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
|
||||
pollingThread st dstatus scanremotes = runEvery (Seconds 3600) $
|
||||
handleConnection st dstatus scanremotes
|
||||
|
||||
handleConnection :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
|
||||
handleConnection st dstatus scanremotes = do
|
||||
rs <- networkRemotes st
|
||||
unless (null rs) $ do
|
||||
let nonspecial = filter (Git.repoIsUrl . Remote.repo) rs
|
||||
unless (null nonspecial) $ do
|
||||
void $ alertWhile dstatus (syncAlert nonspecial) $ do
|
||||
debug thisThread ["syncing with", show nonspecial]
|
||||
sync nonspecial =<< runThreadState st (inRepo Git.Branch.current)
|
||||
addScanRemotes scanremotes nonspecial
|
||||
where
|
||||
sync rs (Just branch) = do
|
||||
runThreadState st $ manualPull (Just branch) rs
|
||||
now <- getCurrentTime
|
||||
pushToRemotes thisThread now st Nothing rs
|
||||
sync _ _ = return True
|
||||
|
||||
{- Finds network remotes. -}
|
||||
networkRemotes :: ThreadState -> IO [Remote]
|
||||
networkRemotes st = runThreadState st $ do
|
||||
rs <- remoteList
|
||||
return $ filter (isNothing . Remote.path) rs
|
Loading…
Add table
Add a link
Reference in a new issue