assistant restart on upgrade

5 files changed, 82 insertions, 16 deletions

diff --git a/Assistant.hs b/Assistant.hs
index f6540045e..6b6b98ebc 100644
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -153,7 +153,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
 #endif
 				, assist $ netWatcherThread
 				, assist $ upgraderThread urlrenderer
-				, assist $ upgradWatcherThread
+				, assist $ upgradWatcherThread urlrenderer
 				, assist $ netWatcherFallbackThread
 				, assist $ transferScannerThread urlrenderer
 				, assist $ cronnerThread urlrenderer
diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index 93eea6d7d..fef78c1f0 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -217,11 +217,10 @@ notFsckedAlert mr button = Alert
 
 canUpgradeAlert :: AlertPriority -> AlertButton -> Alert
 canUpgradeAlert priority button = Alert
-	{ alertHeader = Just $ fromString $ concat
-		[ if priority >= High
+	{ alertHeader = Just $ fromString $
+		if priority >= High
 			then "An important upgrade of git-annex is available!"
 			else "An upgrade of git-annex is available."
-		]
 	, alertIcon = Just UpgradeIcon
 	, alertPriority = priority
 	, alertButton = Just button
@@ -230,11 +229,31 @@ canUpgradeAlert priority button = Alert
 	, alertMessageRender = renderData
 	, alertCounter = 0
 	, alertBlockDisplay = True
-	, alertName = Just UpgradeAlert
+	, alertName = Just CanUpgradeAlert
+	, alertCombiner = Just $ dataCombiner $ \_old new -> new
+	, alertData = []
+	}
+
+upgradeReadyAlert :: AlertButton -> Alert
+upgradeReadyAlert button = Alert
+	{ alertHeader = Just $ fromString
+		"A new version of git-annex has been installed."
+	, alertIcon = Just UpgradeIcon
+	, alertPriority = High
+	, alertButton = Just button
+	, alertClosable = True
+	, alertClass = Message
+	, alertMessageRender = renderData
+	, alertCounter = 0
+	, alertBlockDisplay = True
+	, alertName = Just UpgradeReadyAlert
 	, alertCombiner = Just $ dataCombiner $ \_old new -> new
 	, alertData = []
 	}
 
+upgradingAlert :: Alert
+upgradingAlert = activityAlert Nothing [fromString "Upgrading git-annex"]
+
 brokenRepositoryAlert :: AlertButton -> Alert
 brokenRepositoryAlert = errorAlert "Serious problems have been detected with your repository. This needs your immediate attention!"
 
diff --git a/Assistant/Threads/UpgradeWatcher.hs b/Assistant/Threads/UpgradeWatcher.hs
index cbfefdbbc..707dc0f1d 100644
--- a/Assistant/Threads/UpgradeWatcher.hs
+++ b/Assistant/Threads/UpgradeWatcher.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Assistant.Threads.UpgradeWatcher (
 	upgradWatcherThread
 ) where
@@ -13,19 +15,29 @@ import Assistant.Common
 import Utility.DirWatcher
 import Utility.DirWatcher.Types
 import Config.Files
+import qualified Utility.Lsof as Lsof
+import Utility.ThreadScheduler
+import Assistant.Types.UrlRenderer
+import Assistant.Alert
+import Assistant.DaemonStatus
+#ifdef WITH_WEBAPP
+import Assistant.WebApp.Types
+#endif
 
 import Control.Concurrent.MVar
+import Data.Tuple.Utils
+import qualified Data.Text as T
 
 data WatcherState = InStartupScan | Started | Upgrading
 	deriving (Eq)
 
-upgradWatcherThread :: NamedThread
-upgradWatcherThread = namedThread "UpgradeWatcher" $ go =<< liftIO programPath
+upgradWatcherThread :: UrlRenderer -> NamedThread
+upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ go =<< liftIO programPath
   where
 	go Nothing = debug [ "cannot determine program path" ]
 	go (Just program) = do
 		mvar <- liftIO $ newMVar InStartupScan
-		changed <- Just <$> asIO2 (changedFile mvar program)
+		changed <- Just <$> asIO2 (changedFile urlrenderer mvar program)
 		let hooks = mkWatchHooks
 			{ addHook = changed
 			, addSymlinkHook = changed
@@ -42,10 +54,44 @@ upgradWatcherThread = namedThread "UpgradeWatcher" $ go =<< liftIO programPath
 		void $ swapMVar mvar Started
 		return r
 
-changedFile :: MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant ()
-changedFile mvar program file _status
-	| program == file = do
+changedFile :: UrlRenderer -> MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant ()
+changedFile urlrenderer mvar program file _status
+	| program /= file = noop
+	| otherwise = do
 		state <- liftIO $ readMVar mvar
-		when (state == Started) $
-			debug [ "saw change to", file ]
-	| otherwise = noop
+		when (state == Started) $ do
+			setstate Upgrading
+			ifM (sanityCheck program)
+				( handleUpgrade urlrenderer
+				, do
+					debug ["new version of", program, "failed sanity check; not using"]
+					setstate Started
+				)
+  where
+	setstate = void . liftIO . swapMVar mvar
+
+{- The program's file has been changed. Before restarting,
+ - it needs to not be open for write by anything, and should run
+ - successfully when run with the parameter "version".
+ -}
+sanityCheck :: FilePath -> Assistant Bool
+sanityCheck program = do
+	whileM (liftIO haswriter) $ do
+		debug [program, "is still being written; waiting"]
+		liftIO $ threadDelaySeconds (Seconds 60)
+	debug [program, "has changed, and seems to be ready to run"]
+	liftIO $ boolSystem program [Param "version"]
+  where
+	haswriter = not . null
+		. filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly])
+		. map snd3
+		<$> Lsof.query [program]
+
+handleUpgrade :: UrlRenderer -> Assistant ()
+handleUpgrade urlrenderer = do
+#ifdef WITH_WEBAPP
+	button <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer ConfigFinishUpgradeR
+	void $ addAlert (upgradeReadyAlert button)
+#else
+	noop
+#endif
diff --git a/Assistant/Threads/Upgrader.hs b/Assistant/Threads/Upgrader.hs
index 94f709e16..7a95a711d 100644
--- a/Assistant/Threads/Upgrader.hs
+++ b/Assistant/Threads/Upgrader.hs
@@ -73,7 +73,7 @@ checkUpgrade urlrenderer = do
 canUpgrade :: AlertPriority -> UrlRenderer -> GitAnnexDistribution -> Assistant ()
 canUpgrade urgency urlrenderer d = do
 #ifdef WITH_WEBAPP
-	button <- mkAlertButton False (T.pack "Upgrade") urlrenderer (ConfigUpgradeR d)
+	button <- mkAlertButton True (T.pack "Upgrade") urlrenderer (ConfigStartUpgradeR d)
 	void $ addAlert (canUpgradeAlert urgency button)
 #else
 	noop
diff --git a/Assistant/Types/Alert.hs b/Assistant/Types/Alert.hs
index c2a89a698..c601c60db 100644
--- a/Assistant/Types/Alert.hs
+++ b/Assistant/Types/Alert.hs
@@ -31,7 +31,8 @@ data AlertName
 	| CloudRepoNeededAlert
 	| SyncAlert
 	| NotFsckedAlert
-	| UpgradeAlert
+	| CanUpgradeAlert
+	| UpgradeReadyAlert
 	deriving (Eq)
 
 {- The first alert is the new alert, the second is an old alert.