assistant restart on upgrade

Assistant/WebApp/Configurators/Upgrade.hs

@@ -10,15 +10,47 @@
 module Assistant.WebApp.Configurators.Upgrade where
 
 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 Utility.HumanTime
+import Git
 
 import Data.Time.Clock
+import Control.Concurrent
 
-getConfigUpgradeR :: GitAnnexDistribution -> Handler Html
-getConfigUpgradeR d = page "Upgrade git-annex" (Just Configuration) $ do
+getConfigStartUpgradeR :: GitAnnexDistribution -> Handler Html
+getConfigStartUpgradeR d = page "Upgrade git-annex" (Just Configuration) $ do
 	now <- liftIO getCurrentTime
 	let upgradeage = Duration $ floor $
 		now `diffUTCTime` distributionReleasedate d
-	$(widgetFile "configurators/upgrade")
+	$(widgetFile "configurators/upgrade/start")
 
+{- 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.
+ -}
+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)
+	ret <- switchToAssistant =<< liftAnnex (repoLocation <$> Annex.gitRepo)
+	void . liftIO . forkIO =<< liftAssistant (asIO reaper)
+	return ret
+  where
+	-- Wait for the redirect to be served to the browser
+	-- before terminating this process.
+	reaper = do
+		liftIO $ threadDelaySeconds (Seconds 120)
+		liftIO $ exitSuccess

Assistant/WebApp/OtherRepos.hs

@@ -35,14 +35,17 @@ listOtherRepos = do
 	names <- mapM relHome gooddirs
 	return $ sort $ zip names gooddirs
 
-{- Starts up the assistant in the repository, and waits for it to create
- - a gitAnnexUrlFile. Waits for the assistant to be up and listening for
- - connections by testing the url. Once it's running, redirect to it.
- -}
 getSwitchToRepositoryR :: FilePath -> Handler Html
 getSwitchToRepositoryR repo = do
-	liftIO $ startAssistant repo
 	liftIO $ addAutoStartFile repo -- make this the new default repo
+	switchToAssistant repo
+
+{- Starts up the assistant in the repository, and waits for it to create
+ - a gitAnnexUrlFile. Waits for the assistant to be up and listening for
+ - connections by testing the url. Once it's running, redirect to it. -}
+switchToAssistant :: FilePath -> Handler Html
+switchToAssistant repo = do
+	liftIO $ startAssistant repo
 	redirect =<< liftIO geturl
   where
 	geturl = do

Assistant/WebApp/routes

@@ -21,7 +21,8 @@
 /config/xmpp/needcloudrepo/#UUID NeedCloudRepoR GET
 /config/fsck ConfigFsckR GET POST
 /config/fsck/preferences ConfigFsckPreferencesR POST
-/config/upgrade/#GitAnnexDistribution ConfigUpgradeR GET
+/config/upgrade/start/#GitAnnexDistribution ConfigStartUpgradeR GET
+/config/upgrade/finish ConfigFinishUpgradeR GET
 
 /config/addrepository AddRepositoryR GET
 /config/repository/new NewRepositoryR GET POST