enqueue Downloads when new symlinks appear to content we don't have

This commit is contained in:
Joey Hess 2012-07-05 10:58:49 -06:00
parent c8135ea0a8
commit 6af319d8cd
3 changed files with 35 additions and 21 deletions

View file

@ -113,8 +113,8 @@ startDaemon assistant foreground
, mergeThread st , mergeThread st
, transferWatcherThread st dstatus , transferWatcherThread st dstatus
, daemonStatusThread st dstatus , daemonStatusThread st dstatus
, sanityCheckerThread st dstatus changechan , sanityCheckerThread st dstatus transferqueue changechan
, watchThread st dstatus changechan , watchThread st dstatus transferqueue changechan
] ]
waitForTermination waitForTermination

View file

@ -14,14 +14,15 @@ import qualified Git.LsFiles
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Assistant.ThreadedMonad import Assistant.ThreadedMonad
import Assistant.Changes import Assistant.Changes
import Assistant.TransferQueue
import Utility.ThreadScheduler import Utility.ThreadScheduler
import qualified Assistant.Threads.Watcher as Watcher import qualified Assistant.Threads.Watcher as Watcher
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
{- This thread wakes up occasionally to make sure the tree is in good shape. -} {- This thread wakes up occasionally to make sure the tree is in good shape. -}
sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO () sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO ()
sanityCheckerThread st status changechan = forever $ do sanityCheckerThread st status transferqueue changechan = forever $ do
waitForNextCheck st status waitForNextCheck st status
runThreadState st $ runThreadState st $
@ -29,7 +30,7 @@ sanityCheckerThread st status changechan = forever $ do
{ sanityCheckRunning = True } { sanityCheckRunning = True }
now <- getPOSIXTime -- before check started now <- getPOSIXTime -- before check started
catchIO (check st status changechan) catchIO (check st status transferqueue changechan)
(runThreadState st . warning . show) (runThreadState st . warning . show)
runThreadState st $ do 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 {- 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 - running potentially expensive parts of this check, since remaining in it
- will block the watcher. -} - will block the watcher. -}
check :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO () check :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO ()
check st status changechan = do check st status transferqueue changechan = do
g <- runThreadState st $ do g <- runThreadState st $ do
showSideAction "Running daily check" showSideAction "Running daily check"
fromRepo id fromRepo id
@ -79,5 +80,5 @@ check st status changechan = do
insanity m = runThreadState st $ warning m insanity m = runThreadState st $ warning m
addsymlink file s = do addsymlink file s = do
insanity $ "found unstaged symlink: " ++ file insanity $ "found unstaged symlink: " ++ file
Watcher.runHandler st status changechan Watcher.runHandler st status transferqueue changechan
Watcher.onAddSymlink file s Watcher.onAddSymlink file s

View file

@ -13,6 +13,8 @@ import Common.Annex
import Assistant.ThreadedMonad import Assistant.ThreadedMonad
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Assistant.Changes import Assistant.Changes
import Assistant.TransferQueue
import Logs.Transfer
import Utility.DirWatcher import Utility.DirWatcher
import Utility.Types.DirWatcher import Utility.Types.DirWatcher
import qualified Annex import qualified Annex
@ -45,11 +47,11 @@ needLsof = error $ unlines
, "Be warned: This can corrupt data in the annex, and make fsck complain." , "Be warned: This can corrupt data in the annex, and make fsck complain."
] ]
watchThread :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO () watchThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO ()
watchThread st dstatus changechan = void $ watchDir "." ignored hooks startup watchThread st dstatus transferqueue changechan = void $ watchDir "." ignored hooks startup
where where
startup = statupScan st dstatus startup = statupScan st dstatus
hook a = Just $ runHandler st dstatus changechan a hook a = Just $ runHandler st dstatus transferqueue changechan a
hooks = WatchHooks hooks = WatchHooks
{ addHook = hook onAdd { addHook = hook onAdd
, delHook = hook onDel , delHook = hook onDel
@ -82,22 +84,22 @@ ignored = ig . takeFileName
ig ".gitattributes" = True ig ".gitattributes" = True
ig _ = False 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 {- Runs an action handler, inside the Annex monad, and if there was a
- change, adds it to the ChangeChan. - change, adds it to the ChangeChan.
- -
- Exceptions are ignored, otherwise a whole watcher thread could be crashed. - Exceptions are ignored, otherwise a whole watcher thread could be crashed.
-} -}
runHandler :: ThreadState -> DaemonStatusHandle -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO () runHandler :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
runHandler st dstatus changechan handler file filestatus = void $ do runHandler st dstatus transferqueue changechan handler file filestatus = void $ do
r <- tryIO go r <- tryIO go
case r of case r of
Left e -> print e Left e -> print e
Right Nothing -> noop Right Nothing -> noop
Right (Just change) -> recordChange changechan change Right (Just change) -> recordChange changechan change
where 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 {- 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 - 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. - the add.
-} -}
onAdd :: Handler onAdd :: Handler
onAdd file filestatus dstatus onAdd file filestatus dstatus _
| maybe False isRegularFile filestatus = do | maybe False isRegularFile filestatus = do
ifM (scanComplete <$> getDaemonStatus dstatus) ifM (scanComplete <$> getDaemonStatus dstatus)
( go ( go
@ -136,12 +138,15 @@ onAdd file filestatus dstatus
- before adding it. - before adding it.
-} -}
onAddSymlink :: Handler onAddSymlink :: Handler
onAddSymlink file filestatus dstatus = go =<< Backend.lookupFile file onAddSymlink file filestatus dstatus transferqueue = go =<< Backend.lookupFile file
where where
go (Just (key, _)) = do go (Just (key, _)) = do
link <- calcGitLink file key link <- calcGitLink file key
ifM ((==) link <$> liftIO (readSymbolicLink file)) ifM ((==) link <$> liftIO (readSymbolicLink file))
( ensurestaged link =<< getDaemonStatus dstatus ( do
s <- getDaemonStatus dstatus
checkcontent key s
ensurestaged link s
, do , do
liftIO $ removeFile file liftIO $ removeFile file
liftIO $ createSymbolicLink link file liftIO $ createSymbolicLink link file
@ -183,8 +188,16 @@ onAddSymlink file filestatus dstatus = go =<< Backend.lookupFile file
stageSymlink file sha stageSymlink file sha
madeChange file LinkChange 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 :: Handler
onDel file _ _dstatus = do onDel file _ _dstatus _ = do
Annex.Queue.addUpdateIndex =<< Annex.Queue.addUpdateIndex =<<
inRepo (Git.UpdateIndex.unstageFile file) inRepo (Git.UpdateIndex.unstageFile file)
madeChange file RmChange 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 - command to get the recursive list of files in the directory, so rm is
- just as good. -} - just as good. -}
onDelDir :: Handler onDelDir :: Handler
onDelDir dir _ _dstatus = do onDelDir dir _ _dstatus _ = do
Annex.Queue.addCommand "rm" Annex.Queue.addCommand "rm"
[Params "--quiet -r --cached --ignore-unmatch --"] [dir] [Params "--quiet -r --cached --ignore-unmatch --"] [dir]
madeChange dir RmDirChange madeChange dir RmDirChange
{- Called when there's an error with inotify. -} {- Called when there's an error with inotify. -}
onErr :: Handler onErr :: Handler
onErr msg _ _dstatus = do onErr msg _ _dstatus _ = do
warning msg warning msg
return Nothing return Nothing