diff options
author | 2016-12-24 14:48:51 -0400 | |
---|---|---|
committer | 2016-12-24 15:01:55 -0400 | |
commit | 42e08cd4575d3dc558dfe172c1f28c752d69e8c6 (patch) | |
tree | 78a8eddc31c390aaf8f66435bb13db9366f9a7c4 /CmdLine/GitRemoteTorAnnex.hs | |
parent | 34f375526f44ff255d45bbabcd1425b3d5d0bb4a (diff) | |
parent | 3b9d9a267b7c9247d36d9b622e1b836724ca5fb0 (diff) |
Merge branch 'master' into no-xmpp
Diffstat (limited to 'CmdLine/GitRemoteTorAnnex.hs')
-rw-r--r-- | CmdLine/GitRemoteTorAnnex.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/CmdLine/GitRemoteTorAnnex.hs b/CmdLine/GitRemoteTorAnnex.hs new file mode 100644 index 000000000..5208a47ca --- /dev/null +++ b/CmdLine/GitRemoteTorAnnex.hs @@ -0,0 +1,66 @@ +{- git-remote-tor-annex program + - + - Copyright 2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module CmdLine.GitRemoteTorAnnex where + +import Common +import qualified Annex +import qualified Git.CurrentRepo +import P2P.Protocol +import P2P.IO +import Utility.Tor +import Utility.AuthToken +import Annex.UUID +import P2P.Address +import P2P.Auth + +run :: [String] -> IO () +run (_remotename:address:[]) = forever $ do + -- gitremote-helpers protocol + l <- getLine + case l of + "capabilities" -> putStrLn "connect" >> ready + "connect git-upload-pack" -> go UploadPack + "connect git-receive-pack" -> go ReceivePack + _ -> error $ "git-remote-helpers protocol error at " ++ show l + where + (onionaddress, onionport) + | '/' `elem` address = parseAddressPort $ + reverse $ takeWhile (/= '/') $ reverse address + | otherwise = parseAddressPort address + go service = do + ready + either giveup exitWith + =<< connectService onionaddress onionport service + ready = do + putStrLn "" + hFlush stdout + +run (_remotename:[]) = giveup "remote address not configured" +run _ = giveup "expected remote name and address parameters" + +parseAddressPort :: String -> (OnionAddress, OnionPort) +parseAddressPort s = + let (a, sp) = separate (== ':') s + in case readish sp of + Nothing -> giveup "onion address must include port number" + Just p -> (OnionAddress a, p) + +connectService :: OnionAddress -> OnionPort -> Service -> IO (Either String ExitCode) +connectService address port service = do + state <- Annex.new =<< Git.CurrentRepo.get + Annex.eval state $ do + authtoken <- fromMaybe nullAuthToken + <$> loadP2PRemoteAuthToken (TorAnnex address port) + myuuid <- getUUID + g <- Annex.gitRepo + conn <- liftIO $ connectPeer g (TorAnnex address port) + liftIO $ runNetProto conn $ do + v <- auth myuuid authtoken + case v of + Just _theiruuid -> connect service stdin stdout + Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv |