git-annex-shell: Added notifychanges command.

This will be used by the remote-daemon to quickly tell when changes have
been pushed from some other repository into a ssh remote.

Adjusted the remote-daemon protocol to communicate changed shas, rather
than git branch refs. This way, it can easily check if a sha is new.

This commit was sponsored by Carlos Trijueque Albarran.

1 files changed, 83 insertions, 0 deletions

diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs
new file mode 100644
index 000000000..a1a076718
--- /dev/null
+++ b/Command/NotifyChanges.hs
@@ -0,0 +1,83 @@
+{- git-annex-shell command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.NotifyChanges where
+
+import Common.Annex
+import Command
+import Utility.DirWatcher
+import Utility.DirWatcher.Types
+import qualified Git
+import Git.Sha
+import RemoteDaemon.EndPoint.GitAnnexShell.Types
+
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Concurrent.STM
+
+def :: [Command]
+def = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing
+	"sends notification when git refs are changed"]
+
+seek :: CommandSeek
+seek = withNothing start
+
+start :: CommandStart
+start = do
+	-- This channel is used to accumulate notifcations,
+	-- because the DirWatcher might have multiple threads that find
+	-- changes at the same time.
+	chan <- liftIO newTChanIO
+	
+	g <- gitRepo
+	let refdir = Git.localGitDir g </> "refs"
+	liftIO $ createDirectoryIfMissing True refdir
+
+	let notifyhook = Just $ notifyHook chan
+	let hooks = mkWatchHooks
+		{ addHook = notifyhook
+		, modifyHook = notifyhook
+		}
+
+	void $ liftIO $ watchDir refdir (const False) True hooks id
+
+	let sender = do
+		send READY
+		forever $ send . CHANGED =<< drain chan
+	
+	-- No messages need to be received from the caller,
+	-- but when it closes the connection, notice and terminate.
+	let receiver = forever $ void $ getLine
+	void $ liftIO $ concurrently sender receiver
+	stop
+
+notifyHook :: TChan Git.Sha -> FilePath -> Maybe FileStatus -> IO ()
+notifyHook chan reffile _
+	| ".lock" `isSuffixOf` reffile = noop
+	| otherwise = void $ do
+		sha <- catchDefaultIO Nothing $
+			extractSha <$> readFile reffile
+		maybe noop (atomically . writeTChan chan) sha
+
+-- When possible, coalesce ref writes that occur closely together
+-- in time. Delay up to 0.05 seconds to get more ref writes.
+drain :: TChan Git.Sha -> IO [Git.Sha]
+drain chan = do
+	r <- atomically $ readTChan chan
+	threadDelay 50000
+	rs <- atomically $ drain' chan
+	return (r:rs)
+
+drain' :: TChan Git.Sha -> STM [Git.Sha]
+drain' chan = loop []
+  where
+	loop rs = maybe (return rs) (\r -> loop (r:rs)) =<< tryReadTChan chan
+
+send :: Notification -> IO ()
+send n = do
+	putStrLn $ unwords $ formatMessage n
+	hFlush stdout