diff options
| -rw-r--r-- | Assistant/XMPP/Git.hs | 71 | ||||
| -rw-r--r-- | Command/XMPPGit.hs | 24 | ||||
| -rw-r--r-- | GitAnnex.hs | 11 | ||||
| -rw-r--r-- | doc/design/assistant/xmpp.mdwn | 24 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 4 |
5 files changed, 131 insertions, 3 deletions
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 154cbc86d..cdaa0831a 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -16,10 +16,17 @@ import Assistant.MakeRemote import Assistant.Sync import Annex.UUID import Config +import Git.Types +import Locations.UserConfig import qualified Types.Remote as Remote import Network.Protocol.XMPP import qualified Data.Text as T +import System.Posix.Env +import System.Posix.Types + +configKey :: Remote -> ConfigKey +configKey r = remoteConfig (Remote.repo r) "xmppaddress" finishXMPPPairing :: JID -> UUID -> Assistant () finishXMPPPairing jid u = void $ alertWhile alert $ @@ -40,10 +47,72 @@ makeXMPPGitRemote buddyname jid u = do liftAnnex $ do let r = Remote.repo remote storeUUID (remoteConfig r "uuid") u - setConfig (remoteConfig r "xmppaddress") xmppaddress + setConfig (configKey remote) xmppaddress syncNewRemote remote return True where xmppaddress = T.unpack $ formatJID $ baseJID jid +{- Pushes the named refs to the remote, over XMPP. + - + - Strategy: Set GIT_SSH to run git-annex. By setting the remote url + - to "xmppgit:dummy", "git-annex xmppgit" will be run locally by + - "git push". The dataflow them becomes: + - + - git push <--> git-annex xmppgit <--> xmppPush <-------> xmpp + - | + - git receive-pack <--> xmppReceivePack <---------------> xmpp + - + - The pipe between git-annex xmppgit and us is set up and communicated + - using two file descriptors, GIT_ANNEX_XMPPGIT_IN and + - GIT_ANNEX_XMPPGIT_OUT. It simply connects those up to its stdin + - and stdout, respectively, which are in turn connected to "git-push". + - There is also a GIT_ANNEX_XMPPGIT_CONTROL descriptor, to which an + - exit status is sent for xmppgit to propigate. + - + - We listen at the other end of the pipe and relay to and from XMPP. + -} +xmppPush :: Remote -> [Ref] -> Assistant Bool +xmppPush remote refs = do + program <- liftIO readProgramFile + + -- GIT_SSH=program git -c remote.xmppremote.url=xmppgit:dummy push xmppremote refs + error "TODO" + +relayIn :: String +relayIn = "GIT_ANNEX_XMPPGIT_IN" + +relayOut :: String +relayOut = "GIT_ANNEX_XMPPGIT_OUT" + +relayControl :: String +relayControl = "GIT_ANNEX_XMPPGIT_CONTROL" + +relayFd :: String -> IO Fd +relayFd var = do + v <- getEnv var + case readish =<< v of + Nothing -> error $ var ++ " not set" + Just n -> return $ Fd n + +{- Called by git-annex xmppgit. -} +xmppGitRelay :: IO () +xmppGitRelay = do + inf <- relayFd relayIn + outf <-relayFd relayOut + + void $ dupTo stdInput outf + void $ dupTo inf stdOutput + + controlh <- fdToHandle =<< relayFd relayControl + s <- hGetLine controlh + exitWith $ case readish s of + Just n + | n == 0 -> ExitSuccess + | otherwise -> ExitFailure n + Nothing -> ExitFailure 1 +{- Relays git receive-pack to and from XMPP. The command needs no + - parameters except the directory to run in. -} +xmppReceivePack :: Assistant Bool +xmppReceivePack = error "TODO" diff --git a/Command/XMPPGit.hs b/Command/XMPPGit.hs new file mode 100644 index 000000000..ca7058c12 --- /dev/null +++ b/Command/XMPPGit.hs @@ -0,0 +1,24 @@ +{- git-annex command + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.XMPPGit where + +import Common.Annex +import Command +import Assistant.XMPP.Git + +def :: [Command] +def = [noCommit $ noRepo xmppGitRelay $ dontCheck repoExists $ + command "xmppgit" paramNothing seek "git to XMPP relay (internal use)"] + +seek :: [CommandSeek] +seek = [withWords start] + +start :: [String] -> CommandStart +start _ = do + liftIO xmppGitRelay + stop diff --git a/GitAnnex.hs b/GitAnnex.hs index c35846df7..26a591133 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -64,14 +64,17 @@ import qualified Command.Import import qualified Command.Map import qualified Command.Upgrade import qualified Command.Version +import qualified Command.Help #ifdef WITH_ASSISTANT import qualified Command.Watch import qualified Command.Assistant #ifdef WITH_WEBAPP import qualified Command.WebApp #endif +#ifdef WITH_XMPP +import qualified Command.XMPPGit +#endif #endif -import qualified Command.Help cmds :: [Command] cmds = concat @@ -117,14 +120,18 @@ cmds = concat , Command.Map.def , Command.Upgrade.def , Command.Version.def + , Command.Help.def #ifdef WITH_ASSISTANT , Command.Watch.def , Command.Assistant.def + , Command.XMPPGit.def #ifdef WITH_WEBAPP , Command.WebApp.def #endif +#ifdef WITH_XMPP + , Command.XMPPGit.def +#endif #endif - , Command.Help.def ] options :: [Option] diff --git a/doc/design/assistant/xmpp.mdwn b/doc/design/assistant/xmpp.mdwn index 3c8864021..84d3a5c0e 100644 --- a/doc/design/assistant/xmpp.mdwn +++ b/doc/design/assistant/xmpp.mdwn @@ -54,6 +54,30 @@ For pairing, a chat message is sent, containing: <git-annex xmlns='git-annex' pairing="PairReq|PairAck|PairDone uuid" /> +### git push over XMPP + +To request that a peer push to us, a chat message can be sent: + + <git-annex xmlns='git-annex' startpush="" /> + +When a peer is ready to send a git push, it sends: + + <git-annex xmlns='git-annex' startingpush="" /> + +The receiver runs `git receive-pack`, and sends back its output in +one or more chat messages: + + <git-annex xmlns='git-annex' rp="007b27ca394d26a05d9b6beefa1b07da456caa2157d7 refs/heads/git-annex report-status delete-refs side-band-64k quiet ofs-delta" /> + +The sender replies with the data from `git push`: + + <git-annex xmlns='git-annex' sp="data" /> + +When `git receive-pack` edits, the receiver indicates its exit +status: + + <git-annex xmlns='git-annex' rpdone="0" /> + ### security Data git-annex sends over XMPP will be visible to the XMPP diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 33a209e76..842139c2b 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -486,6 +486,10 @@ subdirectories). With --force, even files whose content is not currently available will be rekeyed. Use with caution. +* xmppgit + + This command is used internally to perform git pulls over XMPP. + # OPTIONS * --force |