diff options
-rw-r--r-- | Assistant.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/UpgradeWatcher.hs | 51 | ||||
-rw-r--r-- | Assistant/Threads/Upgrader.hs | 2 | ||||
-rw-r--r-- | Config/Files.hs | 23 | ||||
-rw-r--r-- | debian/changelog | 4 |
5 files changed, 81 insertions, 1 deletions
diff --git a/Assistant.hs b/Assistant.hs index fd8e18843..f6540045e 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -29,6 +29,7 @@ import Assistant.Threads.MountWatcher #endif import Assistant.Threads.NetWatcher import Assistant.Threads.Upgrader +import Assistant.Threads.UpgradeWatcher import Assistant.Threads.TransferScanner import Assistant.Threads.TransferPoller import Assistant.Threads.ConfigMonitor @@ -152,6 +153,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = #endif , assist $ netWatcherThread , assist $ upgraderThread urlrenderer + , assist $ upgradWatcherThread , assist $ netWatcherFallbackThread , assist $ transferScannerThread urlrenderer , assist $ cronnerThread urlrenderer diff --git a/Assistant/Threads/UpgradeWatcher.hs b/Assistant/Threads/UpgradeWatcher.hs new file mode 100644 index 000000000..cbfefdbbc --- /dev/null +++ b/Assistant/Threads/UpgradeWatcher.hs @@ -0,0 +1,51 @@ +{- git-annex assistant thread to detect when git-annex binary is changed + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Assistant.Threads.UpgradeWatcher ( + upgradWatcherThread +) where + +import Assistant.Common +import Utility.DirWatcher +import Utility.DirWatcher.Types +import Config.Files + +import Control.Concurrent.MVar + +data WatcherState = InStartupScan | Started | Upgrading + deriving (Eq) + +upgradWatcherThread :: NamedThread +upgradWatcherThread = 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) + let hooks = mkWatchHooks + { addHook = changed + , addSymlinkHook = changed + , modifyHook = changed + , delDirHook = changed + } + let dir = parentDir program + let depth = length (splitPath dir) + 1 + let nosubdirs f = length (splitPath f) == depth + void $ liftIO $ watchDir dir nosubdirs hooks (startup mvar) + -- Ignore bogus events generated during the startup scan. + startup mvar scanner = do + r <- scanner + void $ swapMVar mvar Started + return r + +changedFile :: MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant () +changedFile mvar program file _status + | program == file = do + state <- liftIO $ readMVar mvar + when (state == Started) $ + debug [ "saw change to", file ] + | otherwise = noop diff --git a/Assistant/Threads/Upgrader.hs b/Assistant/Threads/Upgrader.hs index c6cf82520..94f709e16 100644 --- a/Assistant/Threads/Upgrader.hs +++ b/Assistant/Threads/Upgrader.hs @@ -1,4 +1,4 @@ -{- git-annex assistant thread to detect when upgrade is needed +{- git-annex assistant thread to detect when upgrade is available - - Copyright 2013 Joey Hess <joey@kitenet.net> - diff --git a/Config/Files.hs b/Config/Files.hs index 30ed0a3cf..285ae570b 100644 --- a/Config/Files.hs +++ b/Config/Files.hs @@ -5,11 +5,14 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Config.Files where import Common import Utility.Tmp import Utility.FreeDesktop +import System.Environment {- ~/.config/git-annex/file -} userConfigFile :: FilePath -> IO FilePath @@ -67,3 +70,23 @@ readProgramFile = do ) where cmd = "git-annex" + +{- A fully qualified path to the currently running git-annex program. + - + - getExecutablePath is available since ghc 7.4.2. On OSs it supports + - well, it returns the complete path to the program. But, on other OSs, + - it might return just the basename. + -} +programPath :: IO (Maybe FilePath) +programPath = do +#if MIN_VERSION_base(4,6,0) + exe <- getExecutablePath + p <- if isAbsolute exe + then return exe + else readProgramFile +#else + p <- readProgramFile +#endif + -- In case readProgramFile returned just the command name, + -- fall back to finding it in PATH. + searchPath p diff --git a/debian/changelog b/debian/changelog index 179e1ec18..f1850b6f0 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,6 +5,10 @@ git-annex (5.20131121) UNRELEASED; urgency=low * webapp: Detect when an upgrade to git-annex is available. (Only when git-annex is installed using the prebuilt binaries from git-annex upstream, not from eg Debian.) + * assistant: Detect when the git-annex binary is modified or replaced, + and either prompt the user to restart the program, or automatically + restart it. + * annex.autoupgrade configures both the above upgrade behaviors. -- Joey Hess <joeyh@debian.org> Wed, 20 Nov 2013 18:30:47 -0400 |