added push notifier thread, currently a no-op
Hooked up everything that needs to notify on pushes. Note that syncNewRemote does not notify. This is probably ok, and I'd need to thread more state through to make it do so. This is only set up to support a single push notification method; I didn't use a NotificationBroadcaster. Partly because I don't yet know what info about pushes needs to be communicated, so my data types are only preliminary.
This commit is contained in:
Joey Hess
parent
6b6ce30b42
commit
ae8a3ab31e
7 changed files with 100 additions and 50 deletions
|
|
@ -15,6 +15,7 @@ import Assistant.ThreadedMonad
|
|||
import Assistant.DaemonStatus
|
||||
import Assistant.ScanRemotes
|
||||
import Assistant.Sync
|
||||
import Assistant.Pushes
|
||||
import qualified Annex
|
||||
import qualified Git
|
||||
import Utility.ThreadScheduler
|
||||
|
|
@ -38,20 +39,20 @@ import qualified Control.Exception as E
|
|||
thisThread :: ThreadName
|
||||
thisThread = "MountWatcher"
|
||||
|
||||
mountWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread
|
||||
mountWatcherThread st handle scanremotes = thread $
|
||||
mountWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> NamedThread
|
||||
mountWatcherThread st handle scanremotes pushnotifier = thread $
|
||||
#if WITH_DBUS
|
||||
dbusThread st handle scanremotes
|
||||
dbusThread st handle scanremotes pushnotifier
|
||||
#else
|
||||
pollingThread st handle scanremotes
|
||||
pollingThread st handle scanremotes pushnotifier
|
||||
#endif
|
||||
where
|
||||
thread = NamedThread thisThread
|
||||
|
||||
#if WITH_DBUS
|
||||
|
||||
dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
|
||||
dbusThread st dstatus scanremotes = E.catch (go =<< connectSession) onerr
|
||||
dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
|
||||
dbusThread st dstatus scanremotes pushnotifier = E.catch (go =<< connectSession) onerr
|
||||
where
|
||||
go client = ifM (checkMountMonitor client)
|
||||
( do
|
||||
|
|
@ -64,7 +65,7 @@ dbusThread st dstatus scanremotes = E.catch (go =<< connectSession) onerr
|
|||
listen client matcher $ \_event -> do
|
||||
nowmounted <- currentMountPoints
|
||||
wasmounted <- swapMVar mvar nowmounted
|
||||
handleMounts st dstatus scanremotes wasmounted nowmounted
|
||||
handleMounts st dstatus scanremotes pushnotifier wasmounted nowmounted
|
||||
, do
|
||||
runThreadState st $
|
||||
warning "No known volume monitor available through dbus; falling back to mtab polling"
|
||||
|
|
@ -75,7 +76,7 @@ dbusThread st dstatus scanremotes = E.catch (go =<< connectSession) onerr
|
|||
runThreadState st $
|
||||
warning $ "Failed to use dbus; falling back to mtab polling (" ++ show e ++ ")"
|
||||
pollinstead
|
||||
pollinstead = pollingThread st dstatus scanremotes
|
||||
pollinstead = pollingThread st dstatus scanremotes pushnotifier
|
||||
|
||||
{- Examine the list of services connected to dbus, to see if there
|
||||
- are any we can use to monitor mounts. If not, will attempt to start one. -}
|
||||
|
|
@ -137,24 +138,24 @@ mountChanged = [gvfs True, gvfs False, kde, kdefallback]
|
|||
|
||||
#endif
|
||||
|
||||
pollingThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
|
||||
pollingThread st dstatus scanremotes = go =<< currentMountPoints
|
||||
pollingThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
|
||||
pollingThread st dstatus scanremotes pushnotifier = go =<< currentMountPoints
|
||||
where
|
||||
go wasmounted = do
|
||||
threadDelaySeconds (Seconds 10)
|
||||
nowmounted <- currentMountPoints
|
||||
handleMounts st dstatus scanremotes wasmounted nowmounted
|
||||
handleMounts st dstatus scanremotes pushnotifier wasmounted nowmounted
|
||||
go nowmounted
|
||||
|
||||
handleMounts :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> MountPoints -> MountPoints -> IO ()
|
||||
handleMounts st dstatus scanremotes wasmounted nowmounted =
|
||||
mapM_ (handleMount st dstatus scanremotes . mnt_dir) $
|
||||
handleMounts :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> MountPoints -> MountPoints -> IO ()
|
||||
handleMounts st dstatus scanremotes pushnotifier wasmounted nowmounted =
|
||||
mapM_ (handleMount st dstatus scanremotes pushnotifier . mnt_dir) $
|
||||
S.toList $ newMountPoints wasmounted nowmounted
|
||||
|
||||
handleMount :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> FilePath -> IO ()
|
||||
handleMount st dstatus scanremotes dir = do
|
||||
handleMount :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> FilePath -> IO ()
|
||||
handleMount st dstatus scanremotes pushnotifier dir = do
|
||||
debug thisThread ["detected mount of", dir]
|
||||
reconnectRemotes thisThread st dstatus scanremotes
|
||||
reconnectRemotes thisThread st dstatus scanremotes (Just pushnotifier)
|
||||
=<< filter (Git.repoIsLocal . Remote.repo)
|
||||
<$> remotesUnder st dstatus dir
|
||||
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@ import Assistant.ThreadedMonad
|
|||
import Assistant.DaemonStatus
|
||||
import Assistant.ScanRemotes
|
||||
import Assistant.Sync
|
||||
import Assistant.Pushes
|
||||
import Utility.ThreadScheduler
|
||||
import Remote.List
|
||||
import qualified Types.Remote as Remote
|
||||
|
|
@ -32,12 +33,12 @@ import qualified Control.Exception as E
|
|||
thisThread :: ThreadName
|
||||
thisThread = "NetWatcher"
|
||||
|
||||
netWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread
|
||||
netWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> NamedThread
|
||||
#if WITH_DBUS
|
||||
netWatcherThread st dstatus scanremotes = thread $
|
||||
dbusThread st dstatus scanremotes
|
||||
netWatcherThread st dstatus scanremotes pushnotifier = thread $
|
||||
dbusThread st dstatus scanremotes pushnotifier
|
||||
#else
|
||||
netWatcherThread _ _ _ = thread noop
|
||||
netWatcherThread _ _ _ _ = thread noop
|
||||
#endif
|
||||
where
|
||||
thread = NamedThread thisThread
|
||||
|
|
@ -47,17 +48,17 @@ netWatcherThread _ _ _ = thread noop
|
|||
- any networked remotes that may have not been routable for a
|
||||
- while (despite the local network staying up), are synced with
|
||||
- periodically. -}
|
||||
netWatcherFallbackThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread
|
||||
netWatcherFallbackThread st dstatus scanremotes = thread $
|
||||
netWatcherFallbackThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> NamedThread
|
||||
netWatcherFallbackThread st dstatus scanremotes pushnotifier = thread $
|
||||
runEvery (Seconds 3600) $
|
||||
handleConnection st dstatus scanremotes
|
||||
handleConnection st dstatus scanremotes pushnotifier
|
||||
where
|
||||
thread = NamedThread thisThread
|
||||
|
||||
#if WITH_DBUS
|
||||
|
||||
dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
|
||||
dbusThread st dstatus scanremotes = E.catch (go =<< connectSystem) onerr
|
||||
dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
|
||||
dbusThread st dstatus scanremotes pushnotifier = E.catch (go =<< connectSystem) onerr
|
||||
where
|
||||
go client = ifM (checkNetMonitor client)
|
||||
( do
|
||||
|
|
@ -72,7 +73,7 @@ dbusThread st dstatus scanremotes = E.catch (go =<< connectSystem) onerr
|
|||
warning $ "Failed to use dbus; falling back to polling (" ++ show e ++ ")"
|
||||
handle = do
|
||||
debug thisThread ["detected network connection"]
|
||||
handleConnection st dstatus scanremotes
|
||||
handleConnection st dstatus scanremotes pushnotifier
|
||||
|
||||
{- Examine the list of services connected to dbus, to see if there
|
||||
- are any we can use to monitor network connections. -}
|
||||
|
|
@ -126,9 +127,9 @@ listenWicdConnections client callback =
|
|||
|
||||
#endif
|
||||
|
||||
handleConnection :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> IO ()
|
||||
handleConnection st dstatus scanremotes =
|
||||
reconnectRemotes thisThread st dstatus scanremotes
|
||||
handleConnection :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
|
||||
handleConnection st dstatus scanremotes pushnotifier =
|
||||
reconnectRemotes thisThread st dstatus scanremotes (Just pushnotifier)
|
||||
=<< networkRemotes st
|
||||
|
||||
{- Finds network remotes. -}
|
||||
|
|
|
|||
21
Assistant/Threads/PushNotifier.hs
Normal file
21
Assistant/Threads/PushNotifier.hs
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
{- git-annex assistant push notification thread
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Assistant.Threads.PushNotifier where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.Pushes
|
||||
|
||||
thisThread :: ThreadName
|
||||
thisThread = "PushNotifier"
|
||||
|
||||
pushNotifierThread :: PushNotifier -> NamedThread
|
||||
pushNotifierThread pushnotifier = thread $ forever $ do
|
||||
waitPush pushnotifier
|
||||
-- TODO
|
||||
where
|
||||
thread = NamedThread thisThread
|
||||
|
|
@ -24,8 +24,8 @@ thisThread :: ThreadName
|
|||
thisThread = "Pusher"
|
||||
|
||||
{- This thread retries pushes that failed before. -}
|
||||
pushRetryThread :: ThreadState -> DaemonStatusHandle -> FailedPushMap -> NamedThread
|
||||
pushRetryThread st dstatus pushmap = thread $ runEvery (Seconds halfhour) $ do
|
||||
pushRetryThread :: ThreadState -> DaemonStatusHandle -> FailedPushMap -> PushNotifier -> NamedThread
|
||||
pushRetryThread st dstatus pushmap pushnotifier = thread $ runEvery (Seconds halfhour) $ do
|
||||
-- We already waited half an hour, now wait until there are failed
|
||||
-- pushes to retry.
|
||||
topush <- getFailedPushesBefore pushmap (fromIntegral halfhour)
|
||||
|
|
@ -37,14 +37,14 @@ pushRetryThread st dstatus pushmap = thread $ runEvery (Seconds halfhour) $ do
|
|||
]
|
||||
now <- getCurrentTime
|
||||
void $ alertWhile dstatus (pushRetryAlert topush) $
|
||||
pushToRemotes thisThread now st (Just pushmap) topush
|
||||
pushToRemotes thisThread now st (Just pushnotifier) (Just pushmap) topush
|
||||
where
|
||||
halfhour = 1800
|
||||
thread = NamedThread thisThread
|
||||
|
||||
{- This thread pushes git commits out to remotes soon after they are made. -}
|
||||
pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> NamedThread
|
||||
pushThread st dstatus commitchan pushmap = thread $ runEvery (Seconds 2) $ do
|
||||
pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> PushNotifier -> NamedThread
|
||||
pushThread st dstatus commitchan pushmap pushnotifier = thread $ runEvery (Seconds 2) $ do
|
||||
-- We already waited two seconds as a simple rate limiter.
|
||||
-- Next, wait until at least one commit has been made
|
||||
commits <- getCommits commitchan
|
||||
|
|
@ -56,7 +56,7 @@ pushThread st dstatus commitchan pushmap = thread $ runEvery (Seconds 2) $ do
|
|||
<$> getDaemonStatus dstatus
|
||||
unless (null remotes) $
|
||||
void $ alertWhile dstatus (pushAlert remotes) $
|
||||
pushToRemotes thisThread now st (Just pushmap) remotes
|
||||
pushToRemotes thisThread now st (Just pushnotifier) (Just pushmap) remotes
|
||||
else do
|
||||
debug thisThread
|
||||
[ "delaying push of"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue