From 6af319d8cdefb4589d9cd354dbc49006bb7d68ea Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 5 Jul 2012 10:58:49 -0600 Subject: [PATCH] enqueue Downloads when new symlinks appear to content we don't have --- Assistant.hs | 4 +-- Assistant/Threads/SanityChecker.hs | 13 +++++----- Assistant/Threads/Watcher.hs | 39 ++++++++++++++++++++---------- 3 files changed, 35 insertions(+), 21 deletions(-) diff --git a/Assistant.hs b/Assistant.hs index 548850e92d..82ac2037e3 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -113,8 +113,8 @@ startDaemon assistant foreground , mergeThread st , transferWatcherThread st dstatus , daemonStatusThread st dstatus - , sanityCheckerThread st dstatus changechan - , watchThread st dstatus changechan + , sanityCheckerThread st dstatus transferqueue changechan + , watchThread st dstatus transferqueue changechan ] waitForTermination diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 4db2a61b22..d7b117cd02 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -14,14 +14,15 @@ import qualified Git.LsFiles import Assistant.DaemonStatus import Assistant.ThreadedMonad import Assistant.Changes +import Assistant.TransferQueue import Utility.ThreadScheduler import qualified Assistant.Threads.Watcher as Watcher import Data.Time.Clock.POSIX {- This thread wakes up occasionally to make sure the tree is in good shape. -} -sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO () -sanityCheckerThread st status changechan = forever $ do +sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO () +sanityCheckerThread st status transferqueue changechan = forever $ do waitForNextCheck st status runThreadState st $ @@ -29,7 +30,7 @@ sanityCheckerThread st status changechan = forever $ do { sanityCheckRunning = True } now <- getPOSIXTime -- before check started - catchIO (check st status changechan) + catchIO (check st status transferqueue changechan) (runThreadState st . warning . show) runThreadState st $ do @@ -58,8 +59,8 @@ oneDay = 24 * 60 * 60 {- It's important to stay out of the Annex monad as much as possible while - running potentially expensive parts of this check, since remaining in it - will block the watcher. -} -check :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO () -check st status changechan = do +check :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO () +check st status transferqueue changechan = do g <- runThreadState st $ do showSideAction "Running daily check" fromRepo id @@ -79,5 +80,5 @@ check st status changechan = do insanity m = runThreadState st $ warning m addsymlink file s = do insanity $ "found unstaged symlink: " ++ file - Watcher.runHandler st status changechan + Watcher.runHandler st status transferqueue changechan Watcher.onAddSymlink file s diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index e250f4b4a6..882aab3a78 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -13,6 +13,8 @@ import Common.Annex import Assistant.ThreadedMonad import Assistant.DaemonStatus import Assistant.Changes +import Assistant.TransferQueue +import Logs.Transfer import Utility.DirWatcher import Utility.Types.DirWatcher import qualified Annex @@ -45,11 +47,11 @@ needLsof = error $ unlines , "Be warned: This can corrupt data in the annex, and make fsck complain." ] -watchThread :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO () -watchThread st dstatus changechan = void $ watchDir "." ignored hooks startup +watchThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO () +watchThread st dstatus transferqueue changechan = void $ watchDir "." ignored hooks startup where startup = statupScan st dstatus - hook a = Just $ runHandler st dstatus changechan a + hook a = Just $ runHandler st dstatus transferqueue changechan a hooks = WatchHooks { addHook = hook onAdd , delHook = hook onDel @@ -82,22 +84,22 @@ ignored = ig . takeFileName ig ".gitattributes" = True ig _ = False -type Handler = FilePath -> Maybe FileStatus -> DaemonStatusHandle -> Annex (Maybe Change) +type Handler = FilePath -> Maybe FileStatus -> DaemonStatusHandle -> TransferQueue -> Annex (Maybe Change) {- Runs an action handler, inside the Annex monad, and if there was a - change, adds it to the ChangeChan. - - Exceptions are ignored, otherwise a whole watcher thread could be crashed. -} -runHandler :: ThreadState -> DaemonStatusHandle -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO () -runHandler st dstatus changechan handler file filestatus = void $ do +runHandler :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO () +runHandler st dstatus transferqueue changechan handler file filestatus = void $ do r <- tryIO go case r of Left e -> print e Right Nothing -> noop Right (Just change) -> recordChange changechan change where - go = runThreadState st $ handler file filestatus dstatus + go = runThreadState st $ handler file filestatus dstatus transferqueue {- During initial directory scan, this will be run for any regular files - that are already checked into git. We don't want to turn those into @@ -118,7 +120,7 @@ runHandler st dstatus changechan handler file filestatus = void $ do - the add. -} onAdd :: Handler -onAdd file filestatus dstatus +onAdd file filestatus dstatus _ | maybe False isRegularFile filestatus = do ifM (scanComplete <$> getDaemonStatus dstatus) ( go @@ -136,12 +138,15 @@ onAdd file filestatus dstatus - before adding it. -} onAddSymlink :: Handler -onAddSymlink file filestatus dstatus = go =<< Backend.lookupFile file +onAddSymlink file filestatus dstatus transferqueue = go =<< Backend.lookupFile file where go (Just (key, _)) = do link <- calcGitLink file key ifM ((==) link <$> liftIO (readSymbolicLink file)) - ( ensurestaged link =<< getDaemonStatus dstatus + ( do + s <- getDaemonStatus dstatus + checkcontent key s + ensurestaged link s , do liftIO $ removeFile file liftIO $ createSymbolicLink link file @@ -183,8 +188,16 @@ onAddSymlink file filestatus dstatus = go =<< Backend.lookupFile file stageSymlink file sha madeChange file LinkChange + {- When a new link appears, after the startup scan, + - try to get the key's content. -} + checkcontent key daemonstatus + | scanComplete daemonstatus = unlessM (inAnnex key) $ + queueTransfers transferqueue dstatus + key (Just file) Download + | otherwise = noop + onDel :: Handler -onDel file _ _dstatus = do +onDel file _ _dstatus _ = do Annex.Queue.addUpdateIndex =<< inRepo (Git.UpdateIndex.unstageFile file) madeChange file RmChange @@ -197,14 +210,14 @@ onDel file _ _dstatus = do - command to get the recursive list of files in the directory, so rm is - just as good. -} onDelDir :: Handler -onDelDir dir _ _dstatus = do +onDelDir dir _ _dstatus _ = do Annex.Queue.addCommand "rm" [Params "--quiet -r --cached --ignore-unmatch --"] [dir] madeChange dir RmDirChange {- Called when there's an error with inotify. -} onErr :: Handler -onErr msg _ _dstatus = do +onErr msg _ _dstatus _ = do warning msg return Nothing