diff options
| -rw-r--r-- | Assistant/DaemonStatus.hs | 10 | ||||
| -rw-r--r-- | Assistant/Threads/RemoteControl.hs | 23 | ||||
| -rw-r--r-- | Assistant/Threads/XMPPClient.hs | 1 | ||||
| -rw-r--r-- | Assistant/Types/DaemonStatus.hs | 3 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/design/git-remote-daemon.mdwn | 2 |
6 files changed, 29 insertions, 12 deletions
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index eb842b784..35f8fc856 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -26,6 +26,7 @@ import Data.Time.Clock.POSIX import Data.Time import System.Locale import qualified Data.Map as M +import qualified Data.Set as S import qualified Data.Text as T getDaemonStatus :: Assistant DaemonStatus @@ -78,6 +79,15 @@ updateSyncRemotes = do M.filter $ \alert -> alertName alert /= Just CloudRepoNeededAlert +changeCurrentlyConnected :: (S.Set UUID -> S.Set UUID) -> Assistant () +changeCurrentlyConnected sm = do + modifyDaemonStatus_ $ \ds -> ds + { currentlyConnectedRemotes = sm (currentlyConnectedRemotes ds) + } + v <- currentlyConnectedRemotes <$> getDaemonStatus + debug [show v] + liftIO . sendNotification =<< syncRemotesNotifier <$> getDaemonStatus + updateScheduleLog :: Assistant () updateScheduleLog = liftIO . sendNotification =<< scheduleLogNotifier <$> getDaemonStatus diff --git a/Assistant/Threads/RemoteControl.hs b/Assistant/Threads/RemoteControl.hs index d33a4858d..a886caeb9 100644 --- a/Assistant/Threads/RemoteControl.hs +++ b/Assistant/Threads/RemoteControl.hs @@ -23,8 +23,9 @@ import qualified Types.Remote as Remote import Control.Concurrent import Control.Concurrent.Async import System.Process (std_in, std_out) -import qualified Data.Map as M import Network.URI +import qualified Data.Map as M +import qualified Data.Set as S remoteControlThread :: NamedThread remoteControlThread = namedThread "RemoteControl" $ do @@ -43,9 +44,9 @@ remoteControlThread = namedThread "RemoteControl" $ do responder <- asIO $ remoteResponderThread fromh urimap -- run controller and responder until the remotedaemon dies - liftIO $ do - void $ controller `concurrently` responder - forceSuccessProcess p pid + liftIO $ void $ tryNonAsync $ controller `concurrently` responder + debug ["remotedaemon exited"] + liftIO $ forceSuccessProcess p pid -- feed from the remoteControl channel into the remotedaemon remoteControllerThread :: Handle -> Assistant () @@ -61,14 +62,10 @@ remoteResponderThread :: Handle -> MVar (M.Map URI Remote) -> Assistant () remoteResponderThread fromh urimap = go M.empty where go syncalerts = do - let cont = go syncalerts - let withr uri = withRemote uri urimap cont l <- liftIO $ hGetLine fromh case parseMessage l of - Just (CONNECTED _uri) -> do - cont - Just (DISCONNECTED _uri) -> do - cont + Just (CONNECTED uri) -> changeconnected S.insert uri + Just (DISCONNECTED uri) -> changeconnected S.delete uri Just (SYNCING uri) -> withr uri $ \r -> if M.member (Remote.uuid r) syncalerts then go syncalerts @@ -92,6 +89,12 @@ remoteResponderThread fromh urimap = go M.empty Nothing -> do debug ["protocol error from remotedaemon: ", l] cont + where + cont = go syncalerts + withr uri = withRemote uri urimap cont + changeconnected sm uri = withr uri $ \r -> do + changeCurrentlyConnected $ sm $ Remote.uuid r + cont getURIMap :: Annex (M.Map URI Remote) getURIMap = Remote.remoteMap' id (mkk . Git.location . Remote.repo) diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index ab4de9257..d23f695f6 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -67,6 +67,7 @@ xmppClient urlrenderer d creds = - is not retained. -} liftAssistant $ updateBuddyList (const noBuddies) <<~ buddyList + liftAssistant $ void client liftAssistant $ modifyDaemonStatus_ $ \s -> s { xmppClientID = Nothing } diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs index a618c700d..2adad2828 100644 --- a/Assistant/Types/DaemonStatus.hs +++ b/Assistant/Types/DaemonStatus.hs @@ -52,6 +52,8 @@ data DaemonStatus = DaemonStatus , syncDataRemotes :: [Remote] -- Are we syncing to any cloud remotes? , syncingToCloudRemote :: Bool + -- Set of uuids of remotes that are currently connected. + , currentlyConnectedRemotes :: S.Set UUID -- List of uuids of remotes that we may have gotten out of sync with. , desynced :: S.Set UUID -- Pairing request that is in progress. @@ -104,6 +106,7 @@ newDaemonStatus = DaemonStatus <*> pure [] <*> pure False <*> pure S.empty + <*> pure S.empty <*> pure Nothing <*> newNotificationBroadcaster <*> newNotificationBroadcaster diff --git a/debian/changelog b/debian/changelog index fcbef3fce..bd908fa6c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -6,6 +6,8 @@ git-annex (5.20140406) UNRELEASED; urgency=medium changes to a ssh remote, and pulls. XMPP is no longer needed in this configuration! Requires the remote server have git-annex-shell with notifychanges support. + * webapp: Show a network signal icon next to ssh remotes that + it's currently connected with. -- Joey Hess <joeyh@debian.org> Mon, 07 Apr 2014 16:22:02 -0400 diff --git a/doc/design/git-remote-daemon.mdwn b/doc/design/git-remote-daemon.mdwn index b81a5f33a..ca3a59fce 100644 --- a/doc/design/git-remote-daemon.mdwn +++ b/doc/design/git-remote-daemon.mdwn @@ -170,8 +170,6 @@ TODO: * Remote system might not be available. Find a smart way to detect it, ideally w/o generating network traffic. One way might be to check if the ssh connection caching control socket exists, for example. -* CONNECTED and DISCONNECTED are not wired into any webapp UI; could be - used to show an icon when a ssh remote is available ## telehash |