aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Assistant.hs2
-rw-r--r--Assistant/Threads/UpgradeWatcher.hs51
-rw-r--r--Assistant/Threads/Upgrader.hs2
-rw-r--r--Config/Files.hs23
-rw-r--r--debian/changelog4
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