86e9e88530Added git-remote-p2p-annex, which allows git pull and push to P2P networks provided by external commands. This is a refactor of git-remote-tor-annex, and should just work. Except possibly for quirks with the address parsing. I've checked that the address parsing basically works. One thing I don't understand is why git-remote-tor-annex removes "/*" from the end of the address. The git history does not provide any hints. So I didn't make git-remote-p2p-annex do the same. Maybe that is needed in some situation? But, a P2P address could contain "/", so removing it would be a problem. I can't see anything in gitremote-helpers(7) about why the url might get such a thing added to the end of it. My guess is that is not needed for tor either (but does no harm there since onion addresses never contain "/"). At this point, the implementation of generic P2P transports needs only remotedaemon support.
62 lines
1.9 KiB
Haskell
62 lines
1.9 KiB
Haskell
{- git-remote-p2p-annex program
|
|
-
|
|
- Copyright 2016-2025 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module CmdLine.GitRemoteP2PAnnex where
|
|
|
|
import Common
|
|
import qualified Annex
|
|
import qualified Git.CurrentRepo
|
|
import P2P.Protocol
|
|
import P2P.IO
|
|
import Utility.AuthToken
|
|
import Annex.UUID
|
|
import P2P.Address
|
|
import P2P.Auth
|
|
import Annex.Action
|
|
|
|
run :: [String] -> IO ()
|
|
run = runner mkaddress
|
|
where
|
|
mkaddress address =
|
|
fromMaybe (error $ "unable to parse address: " ++ address) $
|
|
unformatP2PAddress (p2pAnnexScheme ++ ":" ++ address)
|
|
|
|
runner :: (String -> P2PAddress) -> [String] -> IO ()
|
|
runner mkaddress (_remotename:saddress:[]) = forever $
|
|
getLine >>= \case
|
|
"capabilities" -> putStrLn "connect" >> ready
|
|
"connect git-upload-pack" -> go UploadPack
|
|
"connect git-receive-pack" -> go ReceivePack
|
|
l -> giveup $ "gitremote-helpers protocol error at " ++ show l
|
|
where
|
|
address = mkaddress saddress
|
|
go service = do
|
|
ready
|
|
connectService address service >>= \case
|
|
Right exitcode -> exitWith exitcode
|
|
Left e -> giveup $ describeProtoFailure e
|
|
ready = do
|
|
putStrLn ""
|
|
hFlush stdout
|
|
runner _ (_remotename:[]) = giveup "remote address not configured"
|
|
runner _ _ = giveup "expected remote name and address parameters"
|
|
|
|
connectService :: P2PAddress -> Service -> IO (Either ProtoFailure ExitCode)
|
|
connectService address service = do
|
|
state <- Annex.new =<< Git.CurrentRepo.get
|
|
Annex.eval state $ do
|
|
authtoken <- fromMaybe nullAuthToken
|
|
<$> loadP2PRemoteAuthToken address
|
|
myuuid <- getUUID
|
|
g <- Annex.gitRepo
|
|
conn <- liftIO $ connectPeer (Just g) address
|
|
runst <- liftIO $ mkRunState Client
|
|
r <- liftIO $ runNetProto runst conn $ auth myuuid authtoken noop >>= \case
|
|
Just _theiruuid -> connect service stdin stdout
|
|
Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv
|
|
quiesce False
|
|
return r
|