watch git-annex program file to detect upgrades

Not yet wired up to restart the assistant on upgrade; that needs careful
sanity checking to wait until the upgrade is done before restarting.

Used the DirWatcher here, so it gets events for any changes to the
directory containing the program file. (But not subdirs.) This is necessary
in order to detect when the file is renamed as part of the upgrade, which
an inotify on a single file would not detect. (Also, I have DirWatcher code,
but not FileWatcher code.)

Note that upgrades that remove or rename a whole directory tree containing
the executable will *not* trigger this code. So eg, deleting and replacing
the whole standalone tarball dir tree won't work -- but untarring it
over top will. So should dpkg package upgrades.

Added programPath, using a new GHC feature to find the full path to the
executable. The fallback code for old GHC or unsupported OS is less good;
its worst failure mode would be either failing to find the program, and so
not checking for upgrades, or finding a git-annex that's in PATH, but is
not the one running.

This commit was sponsored by John Roepke.
This commit is contained in:
Joey Hess 2013-11-22 18:46:45 -04:00
parent f8a3dd9c3d
commit 766c31c95c
5 changed files with 81 additions and 1 deletions

View file

@ -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

View file

@ -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>
-