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
parent
e0b04f2e37
commit
0fbbec261d
8 changed files with 152 additions and 37 deletions
|
|
@ -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
83
Command/NotifyChanges.hs
Normal 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
|
||||
32
RemoteDaemon/EndPoint/GitAnnexShell/Types.hs
Normal file
32
RemoteDaemon/EndPoint/GitAnnexShell/Types.hs
Normal 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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
6
debian/changelog
vendored
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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`
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue