diff options
| -rw-r--r-- | CmdLine/GitAnnexShell.hs | 2 | ||||
| -rw-r--r-- | Command/NotifyChanges.hs | 83 | ||||
| -rw-r--r-- | RemoteDaemon/EndPoint/GitAnnexShell/Types.hs | 32 | ||||
| -rw-r--r-- | RemoteDaemon/Endpoint/GitAnnexShell/Types.hs | 29 | ||||
| -rw-r--r-- | RemoteDaemon/Types.hs | 19 | ||||
| -rw-r--r-- | debian/changelog | 6 | ||||
| -rw-r--r-- | doc/design/git-remote-daemon.mdwn | 13 | ||||
| -rw-r--r-- | doc/git-annex-shell.mdwn | 5 |
8 files changed, 152 insertions, 37 deletions
diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index f490792b0..6c212b24d 100644 --- a/CmdLine/GitAnnexShell.hs +++ b/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] 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 diff --git a/RemoteDaemon/EndPoint/GitAnnexShell/Types.hs b/RemoteDaemon/EndPoint/GitAnnexShell/Types.hs new file mode 100644 index 000000000..996c4237c --- /dev/null +++ b/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 diff --git a/RemoteDaemon/Endpoint/GitAnnexShell/Types.hs b/RemoteDaemon/Endpoint/GitAnnexShell/Types.hs deleted file mode 100644 index dd8b59d1d..000000000 --- a/RemoteDaemon/Endpoint/GitAnnexShell/Types.hs +++ /dev/null @@ -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 diff --git a/RemoteDaemon/Types.hs b/RemoteDaemon/Types.hs index 746b895f6..b4b8ba066 100644 --- a/RemoteDaemon/Types.hs +++ b/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 diff --git a/debian/changelog b/debian/changelog index 2cb6290d7..161c23850 100644 --- a/debian/changelog +++ b/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, diff --git a/doc/design/git-remote-daemon.mdwn b/doc/design/git-remote-daemon.mdwn index 714005e6f..0658d4583 100644 --- a/doc/design/git-remote-daemon.mdwn +++ b/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` diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn index c015a7bda..c6e8c05c0 100644 --- a/doc/git-annex-shell.mdwn +++ b/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. |