restart on upgrade is working, including automatic restart
Made alerts be able to have multiple buttons, so the alerts about upgrading can have a button that enables automatic upgrades. Implemented automatic upgrading when the program file has changed. Note that when an automatic upgrade happens, the webapp displays an alert about it for a few minutes, and then closes. This still needs work.
This commit is contained in:
parent
56e980215f
commit
6abaf19c41
15 changed files with 136 additions and 75 deletions
|
@ -10,10 +10,10 @@
|
|||
module Assistant.WebApp.Configurators.Local where
|
||||
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.WebApp.OtherRepos
|
||||
import Assistant.WebApp.Gpg
|
||||
import Assistant.WebApp.MakeRemote
|
||||
import Assistant.Sync
|
||||
import Assistant.Upgrade
|
||||
import Init
|
||||
import qualified Git
|
||||
import qualified Git.Construct
|
||||
|
|
|
@ -249,6 +249,7 @@ startLocalPairing stage oncancel alert muuid displaysecret secret = do
|
|||
tid <- liftIO myThreadId
|
||||
let selfdestruct = AlertButton
|
||||
{ buttonLabel = "Cancel"
|
||||
, buttonPrimary = True
|
||||
, buttonUrl = urlrender DashboardR
|
||||
, buttonAction = Just $ const $ do
|
||||
oncancel
|
||||
|
|
|
@ -13,17 +13,12 @@ import Assistant.WebApp.Common
|
|||
import qualified Annex
|
||||
import Types.Distribution
|
||||
import Assistant.WebApp.OtherRepos
|
||||
import Assistant.Threads.Watcher
|
||||
import Assistant.Alert
|
||||
import Assistant.DaemonStatus
|
||||
import Assistant.NamedThread
|
||||
import Utility.ThreadScheduler
|
||||
import Assistant.Upgrade
|
||||
import Utility.HumanTime
|
||||
import Git
|
||||
import Config
|
||||
|
||||
import Data.Time.Clock
|
||||
import Control.Concurrent
|
||||
import System.Posix (getProcessID, signalProcess, sigTERM)
|
||||
|
||||
getConfigStartUpgradeR :: GitAnnexDistribution -> Handler Html
|
||||
getConfigStartUpgradeR d = page "Upgrade git-annex" (Just Configuration) $ do
|
||||
|
@ -35,28 +30,18 @@ getConfigStartUpgradeR d = page "Upgrade git-annex" (Just Configuration) $ do
|
|||
{- Finish upgrade by starting the new assistant in the same repository this
|
||||
- one is running in, and redirecting to it.
|
||||
-
|
||||
- Before the new assistant can be started, have to remove our
|
||||
- gitAnnexUrlFile and our gitAnnexPidFile. Pausing the watcher is also
|
||||
- a good idea, to avoid fighting when two assistants are running in the
|
||||
- same repo.
|
||||
-
|
||||
- Note that only the tag that requested this page gets redirected.
|
||||
- Note that only the browser tab that requested this page gets redirected.
|
||||
- If the user has multiple web browser tabs open to the webapp,
|
||||
- the others will show the upgradingAlert, and keep running until
|
||||
- this process is terminated.
|
||||
-}
|
||||
getConfigFinishUpgradeR :: Handler Html
|
||||
getConfigFinishUpgradeR = do
|
||||
liftAssistant $ void $ addAlert upgradingAlert
|
||||
liftIO . maybe noop (`throwTo` PauseWatcher) =<< liftAssistant (namedThreadId watchThread)
|
||||
liftIO . nukeFile =<< liftAnnex (fromRepo gitAnnexUrlFile)
|
||||
liftIO . nukeFile =<< liftAnnex (fromRepo gitAnnexPidFile)
|
||||
reapself `after` startnewprocess
|
||||
getConfigFinishUpgradeR :: Bool -> Handler Html
|
||||
getConfigFinishUpgradeR enableautoupgrade = do
|
||||
when enableautoupgrade $ liftAnnex $
|
||||
setConfig (annexConfig "autoupgrade")
|
||||
(fromAutoUpgrade AutoUpgrade)
|
||||
liftAssistant prepUpgrade
|
||||
liftIO postUpgrade `after` startnewprocess
|
||||
where
|
||||
-- Wait for the redirect to be served to the browser
|
||||
-- before terminating this process.
|
||||
reapself = liftIO $ void $ forkIO $ do
|
||||
threadDelaySeconds (Seconds 120)
|
||||
signalProcess sigTERM =<< getProcessID
|
||||
startnewprocess = switchToAssistant
|
||||
=<< liftAnnex (repoLocation <$> Annex.gitRepo)
|
||||
|
|
|
@ -43,6 +43,7 @@ xmppNeeded = whenM (isNothing <$> liftAnnex getXMPPCreds) $ do
|
|||
{ buttonLabel = "Configure a Jabber account"
|
||||
, buttonUrl = urlrender XMPPConfigR
|
||||
, buttonAction = Just close
|
||||
, buttonPrimary = True
|
||||
}
|
||||
#else
|
||||
xmppNeeded = return ()
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue