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.

CmdLine/GitAnnexShell.hs

@@ -29,6 +29,7 @@ import qualified Command.RecvKey
 import qualified Command.SendKey
 import qualified Command.TransferInfo
 import qualified Command.Commit
+import qualified Command.NotifyChanges
 import qualified Command.GCryptSetup
 
 cmds_readonly :: [Command]
@@ -37,6 +38,7 @@ cmds_readonly = concat
 	, gitAnnexShellCheck Command.InAnnex.def
 	, gitAnnexShellCheck Command.SendKey.def
 	, gitAnnexShellCheck Command.TransferInfo.def
+	, gitAnnexShellCheck Command.NotifyChanges.def
 	]
 
 cmds_notreadonly :: [Command]

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

RemoteDaemon/EndPoint/GitAnnexShell/Types.hs

@@ -0,0 +1,32 @@
+{- git-remote-daemon, git-annex-shell endpoint, datatypes
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module RemoteDaemon.EndPoint.GitAnnexShell.Types (
+	Notification(..),
+	Proto.serialize,
+	Proto.deserialize,
+	Proto.formatMessage,
+) where
+
+import qualified Utility.SimpleProtocol as Proto
+import RemoteDaemon.Types (ShaList)
+
+data Notification
+	= READY
+	| CHANGED ShaList
+
+instance Proto.Sendable Notification where
+	formatMessage READY = ["READY"]
+	formatMessage (CHANGED shas) = ["CHANGED", Proto.serialize shas]
+
+instance Proto.Receivable Notification where
+	parseCommand "READY" = Proto.parse0 READY
+	parseCommand "CHANGED" = Proto.parse1 CHANGED
+	parseCommand _ = Proto.parseFail

RemoteDaemon/Endpoint/GitAnnexShell/Types.hs

@@ -1,29 +0,0 @@
-{- git-remote-daemon, git-annex-shell endpoint, datatypes
- -
- - Copyright 2014 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module RemoteDaemon.EndPoint.GitAnnexShell.Types where
-
-import Common.Annex
-import qualified Git.Types as Git
-import qualified Utility.SimpleProtocol as Proto
-import RemoteDaemon.Types (RemoteName, RefList)
-
-data Notifications
-	= CHANGED RemoteName RefList
-
-instance Proto.Sendable Notifications where
-	formatMessage (CHANGED remote refs) =
-		["CHANGED"
-		, Proto.serialize remote
-		, Proto.serialize refs
-		]
-
-instance Proto.Receivable Notifications where
-	parseCommand "CHANGED" = Proto.parse2 CHANGED

RemoteDaemon/Types.hs

@@ -10,13 +10,14 @@
 
 module RemoteDaemon.Types where
 
-import Common.Annex
 import qualified Git.Types as Git
 import qualified Utility.SimpleProtocol as Proto
 
 -- Messages that the daemon emits.
 data Emitted
-	= CHANGED RemoteName RefList
+	= CONNECTED RemoteName
+	| DISCONNECTED RemoteName
+	| CHANGED RemoteName ShaList
 	| STATUS RemoteName UserMessage
 	| ERROR RemoteName UserMessage
 
@@ -29,13 +30,17 @@ data Consumed
 
 type RemoteName = String
 type UserMessage = String
-type RefList = [Git.Ref]
+type ShaList = [Git.Sha]
 
 instance Proto.Sendable Emitted where
-	formatMessage (CHANGED remote refs) =
+	formatMessage (CONNECTED remote) =
+		["CONNECTED", Proto.serialize remote]
+	formatMessage (DISCONNECTED remote) =
+		["DISCONNECTED", Proto.serialize remote]
+	formatMessage (CHANGED remote shas) =
 		["CHANGED"
 		, Proto.serialize remote
-		, Proto.serialize refs
+		, Proto.serialize shas
 		]
 	formatMessage (STATUS remote msg) =
 		["STATUS"
@@ -55,6 +60,8 @@ instance Proto.Sendable Consumed where
 	formatMessage RELOAD = ["RELOAD"]
 
 instance Proto.Receivable Emitted where
+	parseCommand "CONNECTED" = Proto.parse1 CONNECTED
+	parseCommand "DISCONNECTED" = Proto.parse1 DISCONNECTED
 	parseCommand "CHANGED" = Proto.parse2 CHANGED
 	parseCommand "STATUS" = Proto.parse2 STATUS
 	parseCommand "ERROR" = Proto.parse2 ERROR
@@ -71,6 +78,6 @@ instance Proto.Serializable [Char] where
 	serialize = id
 	deserialize = Just
 
-instance Proto.Serializable RefList where
+instance Proto.Serializable ShaList where
 	serialize = unwords . map Git.fromRef
 	deserialize = Just . map Git.Ref . words

debian/changelog

@@ -1,3 +1,9 @@
+git-annex (5.20140403) UNRELEASED; urgency=medium
+
+  * git-annex-shell: Added notifychanges command.
+
+ -- Joey Hess <joeyh@debian.org>  Sat, 05 Apr 2014 15:05:44 -0400
+
 git-annex (5.20140402) unstable; urgency=medium
 
   * unannex, uninit: Avoid committing after every file is unannexed,

doc/design/git-remote-daemon.mdwn

@@ -80,9 +80,18 @@ the webapp.
 
 ## emitted messages
 
-* `CHANGED $remote $ref ...`
+* `CONNECTED $remote`
 
-  This indicates that the given refs in the named git remote have changed.
+  Send when a connection has been made with a remote.
+
+* `DISCONNECTED $remote`
+
+  Send when connection with a remote has been lost.
+
+* `CHANGED $remote $sha ...`
+
+  This indicates that refs in the named git remote have changed,
+  and indicates the new shas.
 
 * `STATUS $remote $string`
 

doc/git-annex-shell.mdwn

@@ -65,6 +65,11 @@ first "/~/" or "/~user/" is expanded to the specified home directory.
   This commits any staged changes to the git-annex branch.
   It also runs the annex-content hook.
 
+* notifychanges
+
+  This is used by `git-annex remote-daemon` to be notified when
+  refs in the remote repository are changed.
+
 * gcryptsetup gcryptid
 
   Sets up a repository as a gcrypt repository.