completely untested linux upgrade code

Assistant/Threads/UpgradeWatcher.hs

@@ -1,4 +1,4 @@
-{- git-annex assistant thread to detect when git-annex binary is changed
+{- git-annex assistant thread to detect when git-annex is upgraded
  -
  - Copyright 2013 Joey Hess <joey@kitenet.net>
  -
@@ -15,8 +15,6 @@ import Assistant.Common
 import Assistant.Upgrade
 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
@@ -27,7 +25,6 @@ import qualified Build.SysConfig
 #endif
 
 import Control.Concurrent.MVar
-import Data.Tuple.Utils
 import qualified Data.Text as T
 
 data WatcherState = InStartupScan | Started | Upgrading
@@ -37,12 +34,12 @@ upgradWatcherThread :: UrlRenderer -> NamedThread
 upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do
 	whenM (liftIO $ checkSuccessfulUpgrade) $
 		showSuccessfulUpgrade urlrenderer
-	go =<< liftIO programPath
+	go =<< liftIO upgradeFlagFile
   where
 	go Nothing = debug [ "cannot determine program path" ]
-	go (Just program) = do
+	go (Just flagfile) = do
 		mvar <- liftIO $ newMVar InStartupScan
-		changed <- Just <$> asIO2 (changedFile urlrenderer mvar program)
+		changed <- Just <$> asIO2 (changedFile urlrenderer mvar flagfile)
 		let hooks = mkWatchHooks
 			{ addHook = changed
 			, delHook = changed
@@ -50,7 +47,7 @@ upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do
 			, modifyHook = changed
 			, delDirHook = changed
 			}
-		let dir = parentDir program
+		let dir = parentDir flagfile
 		let depth = length (splitPath dir) + 1
 		let nosubdirs f = length (splitPath f) == depth
 		void $ liftIO $ watchDir dir nosubdirs hooks (startup mvar)
@@ -61,39 +58,21 @@ upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do
 		return r
 
 changedFile :: UrlRenderer -> MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant ()
-changedFile urlrenderer mvar program file _status
-	| program /= file = noop
+changedFile urlrenderer mvar flagfile file _status
+	| flagfile /= file = noop
 	| otherwise = do
 		state <- liftIO $ readMVar mvar
 		when (state == Started) $ do
 			setstate Upgrading
-			ifM (sanityCheck program)
+			ifM (liftIO upgradeSanityCheck)
 				( handleUpgrade urlrenderer
 				, do
-					debug ["new version of", program, "failed sanity check; not using"]
+					debug ["new version 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
-	untilM (liftIO $ present <&&> nowriter) $ 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
-	present = doesFileExist program
-	nowriter = null
-		. filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly])
-		. map snd3
-		<$> Lsof.query [program]
-
 handleUpgrade :: UrlRenderer -> Assistant ()
 handleUpgrade urlrenderer = do
 	-- Wait 2 minutes for any final upgrade changes to settle.