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.
This commit is contained in:
Joey Hess 2014-04-05 16:04:37 -04:00
parent e0b04f2e37
commit 0fbbec261d
8 changed files with 152 additions and 37 deletions

View file

@ -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]

83
Command/NotifyChanges.hs Normal file
View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

6
debian/changelog vendored
View file

@ -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,

View file

@ -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`

View file

@ -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.