42 lines
940 B
Haskell
42 lines
940 B
Haskell
{- 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 gitRemoteHelper
|
|
liftIO xmppGitRelay
|
|
stop
|
|
|
|
{- A basic implementation of the git-remote-helpers protocol. -}
|
|
gitRemoteHelper :: IO ()
|
|
gitRemoteHelper = do
|
|
expect "capabilities"
|
|
respond ["connect"]
|
|
expect "connect git-receive-pack"
|
|
respond []
|
|
where
|
|
expect s = do
|
|
cmd <- getLine
|
|
unless (cmd == s) $
|
|
error $ "git-remote-helpers protocol error: expected: " ++ s ++ ", but got: " ++ cmd
|
|
respond l = do
|
|
mapM_ putStrLn l
|
|
putStrLn ""
|
|
hFlush stdout
|