reconnect XMPP when NetWatcher notices a change

This commit is contained in:
Joey Hess 2012-10-27 00:42:14 -04:00
parent 9fc8257392
commit 2dc40ecbd1
6 changed files with 58 additions and 19 deletions

View file

@ -70,6 +70,7 @@ dbusThread st dstatus scanremotes pushnotifier =
)
handleconn = do
debug thisThread ["detected network connection"]
notifyRestart pushnotifier
handleConnection st dstatus scanremotes pushnotifier
onerr e _ = do
runThreadState st $

View file

@ -28,12 +28,19 @@ import Data.Time.Clock
thisThread :: ThreadName
thisThread = "PushNotifier"
controllerThread :: PushNotifier -> IO () -> IO ()
controllerThread pushnotifier a = forever $ do
tid <- forkIO a
waitRestart pushnotifier
killThread tid
pushNotifierThread :: ThreadState -> DaemonStatusHandle -> PushNotifier -> NamedThread
pushNotifierThread st dstatus pushnotifier = NamedThread thisThread $ do
v <- runThreadState st $ getXMPPCreds
case v of
Nothing -> return () -- no creds? exit thread
Just c -> loop c =<< getCurrentTime
pushNotifierThread st dstatus pushnotifier = NamedThread thisThread $
controllerThread pushnotifier $ do
v <- runThreadState st $ getXMPPCreds
case v of
Nothing -> noop
Just c -> loop c =<< getCurrentTime
where
loop c starttime = do
void $ connectXMPP c $ \jid -> do
@ -53,7 +60,6 @@ pushNotifierThread st dstatus pushnotifier = NamedThread thisThread $ do
threadDelaySeconds (Seconds 300)
loop c =<< getCurrentTime
sendnotifications = forever $ do
us <- liftIO $ waitPush pushnotifier
let payload = [extendedAway, encodePushNotification us]