diff --git a/Assistant/WebApp/Control.hs b/Assistant/WebApp/Control.hs index 93a45a3b86..117547390b 100644 --- a/Assistant/WebApp/Control.hs +++ b/Assistant/WebApp/Control.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp control - - - Copyright 2012 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -10,15 +10,17 @@ module Assistant.WebApp.Control where import Assistant.WebApp.Common -import Utility.LogFile import Assistant.DaemonStatus import Assistant.Alert import Assistant.TransferSlots import Assistant.Restart +import Utility.LogFile +import Utility.NotificationBroadcaster import Control.Concurrent import System.Posix (getProcessID, signalProcess, sigTERM) import qualified Data.Map as M +import qualified Data.Text as T getShutdownR :: Handler Html getShutdownR = page "Shutdown" Nothing $ @@ -37,12 +39,25 @@ getShutdownConfirmedR = do ts <- M.keys . currentTransfers <$> getDaemonStatus mapM_ pauseTransfer ts page "Shutdown" Nothing $ do + webapp <- getYesod + let url = T.unpack $ yesodRender webapp (T.pack "") NotRunningR [] + {- Signal any other web browsers. -} + liftAssistant $ do + modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url } + liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus {- Wait 2 seconds before shutting down, to give the web - page time to load in the browser. -} void $ liftIO $ forkIO $ do threadDelay 2000000 signalProcess sigTERM =<< getProcessID - $(widgetFile "control/shutdownconfirmed") + redirect NotRunningR + +{- Use a custom page to avoid putting long polling elements on it that will + - fail and cause the web browser to show an error once the webapp is + - truely stopped. -} +getNotRunningR :: Handler Html +getNotRunningR = customPage' False Nothing $ + $(widgetFile "control/notrunning") getRestartR :: Handler Html getRestartR = do diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs index ad57f4f601..912370a847 100644 --- a/Assistant/WebApp/Notifications.hs +++ b/Assistant/WebApp/Notifications.hs @@ -28,7 +28,6 @@ import qualified Data.Text as T #ifndef WITH_OLD_YESOD import qualified Data.Aeson.Types as Aeson #endif -import Control.Concurrent {- Add to any widget to make it auto-update using long polling. - @@ -51,7 +50,6 @@ autoUpdate tident geturl ms_delay ms_startdelay = do let startdelay = Aeson.String (T.pack (show ms_startdelay)) let ident = Aeson.String tident #endif - addScript $ StaticR longpolling_js $(widgetFile "notifications/longpolling") {- Notifier urls are requested by the javascript, to avoid allocation @@ -103,14 +101,6 @@ getGlobalRedirBroadcaster = globalRedirNotifier <$> getDaemonStatus getGlobalRedirR :: NotificationId -> Handler Text getGlobalRedirR nid = do - tid <- liftIO myThreadId - liftIO $ do - hPutStrLn stderr $ show ("getGlobalRedirR waiting", tid) - hFlush stderr waitNotifier getGlobalRedirBroadcaster nid - v <- globalRedirUrl <$> liftAssistant getDaemonStatus - liftIO $ do - hPutStrLn stderr $ show ("getGlobalRedirR got a val", v, tid) - hFlush stderr maybe (getGlobalRedirR nid) (return . T.pack) =<< globalRedirUrl <$> liftAssistant getDaemonStatus diff --git a/Assistant/WebApp/Page.hs b/Assistant/WebApp/Page.hs index 92dbf7843c..5d5a205b36 100644 --- a/Assistant/WebApp/Page.hs +++ b/Assistant/WebApp/Page.hs @@ -50,7 +50,10 @@ page title navbaritem content = customPage navbaritem $ do {- A custom page, with no title or sidebar set. -} customPage :: Maybe NavBarItem -> Widget -> Handler Html -customPage navbaritem content = do +customPage = customPage' True + +customPage' :: Bool -> Maybe NavBarItem -> Widget -> Handler Html +customPage' with_longpolling navbaritem content = do webapp <- getYesod case cannotRun webapp of Nothing -> do @@ -62,6 +65,8 @@ customPage navbaritem content = do addScript $ StaticR js_bootstrap_dropdown_js addScript $ StaticR js_bootstrap_modal_js addScript $ StaticR js_bootstrap_collapse_js + when with_longpolling $ + addScript $ StaticR longpolling_js $(widgetFile "page") giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap") Just msg -> error msg diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 80842e6b09..ac5b12a6fb 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -9,6 +9,7 @@ /shutdown ShutdownR GET /shutdown/confirm ShutdownConfirmedR GET +/shutdown/complete NotRunningR GET /restart RestartR GET /restart/thread/#ThreadName RestartThreadR GET /log LogR GET diff --git a/templates/control/notrunning.hamlet b/templates/control/notrunning.hamlet new file mode 100644 index 0000000000..118f02176b --- /dev/null +++ b/templates/control/notrunning.hamlet @@ -0,0 +1,10 @@ +
+

+ Bye bye! +

+
+

+ git-annex has shut down +
+

+ You can now close this browser window. diff --git a/templates/control/notrunning.julius b/templates/control/notrunning.julius new file mode 100644 index 0000000000..7a6859f219 --- /dev/null +++ b/templates/control/notrunning.julius @@ -0,0 +1,3 @@ +$(function() { + $('#shutdownmodal').modal('show'); +}); diff --git a/templates/control/shutdownconfirmed.hamlet b/templates/control/shutdownconfirmed.hamlet deleted file mode 100644 index 18270f588c..0000000000 --- a/templates/control/shutdownconfirmed.hamlet +++ /dev/null @@ -1,2 +0,0 @@ -

- Shutting down...