summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-05 10:58:49 -0600
committerGravatar Joey Hess <joey@kitenet.net>2012-07-05 10:58:49 -0600
commit6af319d8cdefb4589d9cd354dbc49006bb7d68ea (patch)
treefcf9db3e5a430e7fab7df02e87a4d2a58af76058 /Assistant
parentc8135ea0a8aa2b374e45a8bb8c447c5287862838 (diff)
enqueue Downloads when new symlinks appear to content we don't have
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Threads/SanityChecker.hs13
-rw-r--r--Assistant/Threads/Watcher.hs39
2 files changed, 33 insertions, 19 deletions
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index 4db2a61b2..d7b117cd0 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 e250f4b4a..882aab3a7 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