enqueue Downloads when new symlinks appear to content we don't have
This commit is contained in:
parent
c8135ea0a8
commit
6af319d8cd
3 changed files with 35 additions and 21 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue