2016-11-30 18:35:24 +00:00
{- git - annex command
-
- Copyright 2016 Joey Hess < id @ joeyh . name >
-
2019-03-13 19:48:14 +00:00
- Licensed under the GNU AGPL version 3 or higher .
2016-11-30 18:35:24 +00:00
- }
2019-12-05 18:36:43 +00:00
{- # LANGUAGE OverloadedStrings # -}
2016-11-30 18:35:24 +00:00
module Command.P2P where
import Command
import P2P.Address
import P2P.Auth
2016-12-16 22:26:07 +00:00
import P2P.IO
import qualified P2P.Protocol as P2P
2016-11-30 19:14:54 +00:00
import Git.Types
import qualified Git.Remote
2016-12-16 22:26:07 +00:00
import qualified Git.Command
import qualified Annex
import Annex.UUID
import Config
2016-12-18 20:50:58 +00:00
import Utility.AuthToken
2017-12-31 20:08:31 +00:00
import Utility.Tmp.Dir
2016-12-18 20:50:58 +00:00
import Utility.FileMode
import Utility.ThreadScheduler
2023-04-11 18:27:22 +00:00
import Utility.SafeOutput
2020-11-24 16:38:12 +00:00
import qualified Utility.RawFilePath as R
2016-12-18 20:50:58 +00:00
import qualified Utility.MagicWormhole as Wormhole
import Control.Concurrent.Async
import qualified Data.Text as T
2016-11-30 18:35:24 +00:00
cmd :: Command
cmd = command " p2p " SectionSetup
" configure peer-2-peer links between repositories "
paramNothing ( seek <$$> optParser )
data P2POpts
= GenAddresses
2016-12-16 19:36:59 +00:00
| LinkRemote
2016-12-18 20:50:58 +00:00
| Pair
2016-11-30 18:35:24 +00:00
2016-12-16 22:26:07 +00:00
optParser :: CmdParamsDesc -> Parser ( P2POpts , Maybe RemoteName )
optParser _ = ( , )
2016-12-18 20:50:58 +00:00
<$> ( pair <|> linkremote <|> genaddresses )
2016-12-16 19:36:59 +00:00
<*> optional name
2016-11-30 18:35:24 +00:00
where
genaddresses = flag' GenAddresses
( long " gen-addresses "
<> help " generate addresses that allow accessing this repository over P2P networks "
)
2016-12-16 19:36:59 +00:00
linkremote = flag' LinkRemote
2016-11-30 19:14:54 +00:00
( long " link "
2016-12-16 19:36:59 +00:00
<> help " set up a P2P link to a git remote "
)
2016-12-18 20:50:58 +00:00
pair = flag' Pair
( long " pair "
<> help " pair with another repository "
)
name = Git . Remote . makeLegalName <$> strOption
2016-12-16 19:36:59 +00:00
( long " name "
<> metavar paramName
<> help " name of remote "
2016-11-30 19:14:54 +00:00
)
2016-11-30 18:35:24 +00:00
2016-12-16 22:26:07 +00:00
seek :: ( P2POpts , Maybe RemoteName ) -> CommandSeek
seek ( GenAddresses , _ ) = genAddresses =<< loadP2PAddresses
seek ( LinkRemote , Just name ) = commandAction $
2016-12-18 20:50:58 +00:00
linkRemote name
2016-12-16 22:26:07 +00:00
seek ( LinkRemote , Nothing ) = commandAction $
linkRemote =<< unusedPeerRemoteName
2016-12-18 20:50:58 +00:00
seek ( Pair , Just name ) = commandAction $
2016-12-18 21:01:15 +00:00
startPairing name =<< loadP2PAddresses
2016-12-18 20:50:58 +00:00
seek ( Pair , Nothing ) = commandAction $ do
name <- unusedPeerRemoteName
2016-12-18 21:01:15 +00:00
startPairing name =<< loadP2PAddresses
2016-12-16 22:26:07 +00:00
unusedPeerRemoteName :: Annex RemoteName
unusedPeerRemoteName = go ( 1 :: Integer ) =<< usednames
where
2018-01-09 19:36:56 +00:00
usednames = mapMaybe remoteName <$> Annex . getGitRemotes
2016-12-16 22:26:07 +00:00
go n names = do
let name = " peer " ++ show n
if name ` elem ` names
then go ( n + 1 ) names
else return name
2016-12-16 19:36:59 +00:00
2016-11-30 19:14:54 +00:00
-- Only addresses are output to stdout, to allow scripting.
genAddresses :: [ P2PAddress ] -> Annex ()
2023-03-14 02:39:16 +00:00
genAddresses [] = giveup " No P2P networks are currently available. "
2016-11-30 19:14:54 +00:00
genAddresses addrs = do
authtoken <- liftIO $ genAuthToken 128
storeP2PAuthToken authtoken
earlyWarning " These addresses allow access to this git-annex repository. Only share them with people you trust with that access, using trusted communication channels! "
2023-04-11 18:27:22 +00:00
liftIO $ putStr $ safeOutput $ unlines $
2016-11-30 19:14:54 +00:00
map formatP2PAddress $
map ( ` P2PAddressAuth ` authtoken ) addrs
-- Address is read from stdin, to avoid leaking it in shell history.
2016-12-16 22:26:07 +00:00
linkRemote :: RemoteName -> CommandStart
2020-09-14 20:49:33 +00:00
linkRemote remotename = starting " p2p link " ai si $
make CommandStart return a StartMessage
The goal is to be able to run CommandStart in the main thread when -J is
used, rather than unncessarily passing it off to a worker thread, which
incurs overhead that is signficant when the CommandStart is going to
quickly decide to stop.
To do that, the message it displays needs to be displayed in the worker
thread, after the CommandStart has run.
Also, the change will mean that CommandStart will no longer necessarily
run with the same Annex state as CommandPerform. While its docs already
said it should avoid modifying Annex state, I audited all the
CommandStart code as part of the conversion. (Note that CommandSeek
already sometimes runs with a different Annex state, and that has not been
a source of any problems, so I am not too worried that this change will
lead to breakage going forward.)
The only modification of Annex state I found was it calling
allowMessages in some Commands that default to noMessages. Dealt with
that by adding a startCustomOutput and a startingUsualMessages.
This lets a command start with noMessages and then select the output it
wants for each CommandStart.
One bit of breakage: onlyActionOn has been removed from commands that used it.
The plan is that, since a StartMessage contains an ActionItem,
when a Key can be extracted from that, the parallel job runner can
run onlyActionOn' automatically. Then commands won't need to worry about
this detail. Future work.
Otherwise, this was a fairly straightforward process of making each
CommandStart compile again. Hopefully other behavior changes were mostly
avoided.
In a few cases, a command had a CommandStart that called a CommandPerform
that then called showStart multiple times. I have collapsed those
down to a single start action. The main command to perhaps suffer from it
is Command.Direct, which used to show a start for each file, and no
longer does.
Another minor behavior change is that some commands used showStart
before, but had an associated file and a Key available, so were changed
to ShowStart with an ActionItemAssociatedFile. That will not change the
normal output or behavior, but --json output will now include the key.
This should not break it for anyone using a real json parser.
2019-06-06 19:42:30 +00:00
next promptaddr
2016-11-30 19:14:54 +00:00
where
2023-04-08 19:48:32 +00:00
ai = ActionItemOther ( Just ( UnquotedString remotename ) )
2020-09-14 20:49:33 +00:00
si = SeekInput []
2017-05-11 22:31:14 +00:00
promptaddr = do
2016-11-30 19:14:54 +00:00
liftIO $ putStrLn " "
2016-12-07 16:38:21 +00:00
liftIO $ putStr " Enter peer address: "
2016-11-30 19:14:54 +00:00
liftIO $ hFlush stdout
s <- liftIO getLine
if null s
then do
liftIO $ hPutStrLn stderr " Nothing entered, giving up. "
return False
else case unformatP2PAddress s of
Nothing -> do
liftIO $ hPutStrLn stderr " Unable to parse that address, please check its format and try again. "
2017-05-11 22:31:14 +00:00
promptaddr
2016-12-18 20:50:58 +00:00
Just addr -> do
r <- setupLink remotename addr
case r of
LinkSuccess -> return True
ConnectionError e -> giveup e
AuthenticationError e -> giveup e
2016-12-18 21:01:15 +00:00
startPairing :: RemoteName -> [ P2PAddress ] -> CommandStart
2023-03-14 02:39:16 +00:00
startPairing _ [] = giveup " No P2P networks are currently available. "
make CommandStart return a StartMessage
The goal is to be able to run CommandStart in the main thread when -J is
used, rather than unncessarily passing it off to a worker thread, which
incurs overhead that is signficant when the CommandStart is going to
quickly decide to stop.
To do that, the message it displays needs to be displayed in the worker
thread, after the CommandStart has run.
Also, the change will mean that CommandStart will no longer necessarily
run with the same Annex state as CommandPerform. While its docs already
said it should avoid modifying Annex state, I audited all the
CommandStart code as part of the conversion. (Note that CommandSeek
already sometimes runs with a different Annex state, and that has not been
a source of any problems, so I am not too worried that this change will
lead to breakage going forward.)
The only modification of Annex state I found was it calling
allowMessages in some Commands that default to noMessages. Dealt with
that by adding a startCustomOutput and a startingUsualMessages.
This lets a command start with noMessages and then select the output it
wants for each CommandStart.
One bit of breakage: onlyActionOn has been removed from commands that used it.
The plan is that, since a StartMessage contains an ActionItem,
when a Key can be extracted from that, the parallel job runner can
run onlyActionOn' automatically. Then commands won't need to worry about
this detail. Future work.
Otherwise, this was a fairly straightforward process of making each
CommandStart compile again. Hopefully other behavior changes were mostly
avoided.
In a few cases, a command had a CommandStart that called a CommandPerform
that then called showStart multiple times. I have collapsed those
down to a single start action. The main command to perhaps suffer from it
is Command.Direct, which used to show a start for each file, and no
longer does.
Another minor behavior change is that some commands used showStart
before, but had an associated file and a Key available, so were changed
to ShowStart with an ActionItemAssociatedFile. That will not change the
normal output or behavior, but --json output will now include the key.
This should not break it for anyone using a real json parser.
2019-06-06 19:42:30 +00:00
startPairing remotename addrs = ifM ( liftIO Wormhole . isInstalled )
2020-09-14 20:49:33 +00:00
( starting " p2p pair " ai si $
make CommandStart return a StartMessage
The goal is to be able to run CommandStart in the main thread when -J is
used, rather than unncessarily passing it off to a worker thread, which
incurs overhead that is signficant when the CommandStart is going to
quickly decide to stop.
To do that, the message it displays needs to be displayed in the worker
thread, after the CommandStart has run.
Also, the change will mean that CommandStart will no longer necessarily
run with the same Annex state as CommandPerform. While its docs already
said it should avoid modifying Annex state, I audited all the
CommandStart code as part of the conversion. (Note that CommandSeek
already sometimes runs with a different Annex state, and that has not been
a source of any problems, so I am not too worried that this change will
lead to breakage going forward.)
The only modification of Annex state I found was it calling
allowMessages in some Commands that default to noMessages. Dealt with
that by adding a startCustomOutput and a startingUsualMessages.
This lets a command start with noMessages and then select the output it
wants for each CommandStart.
One bit of breakage: onlyActionOn has been removed from commands that used it.
The plan is that, since a StartMessage contains an ActionItem,
when a Key can be extracted from that, the parallel job runner can
run onlyActionOn' automatically. Then commands won't need to worry about
this detail. Future work.
Otherwise, this was a fairly straightforward process of making each
CommandStart compile again. Hopefully other behavior changes were mostly
avoided.
In a few cases, a command had a CommandStart that called a CommandPerform
that then called showStart multiple times. I have collapsed those
down to a single start action. The main command to perhaps suffer from it
is Command.Direct, which used to show a start for each file, and no
longer does.
Another minor behavior change is that some commands used showStart
before, but had an associated file and a Key available, so were changed
to ShowStart with an ActionItemAssociatedFile. That will not change the
normal output or behavior, but --json output will now include the key.
This should not break it for anyone using a real json parser.
2019-06-06 19:42:30 +00:00
performPairing remotename addrs
, giveup " Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/ "
2020-09-14 20:49:33 +00:00
)
where
2023-04-08 19:48:32 +00:00
ai = ActionItemOther ( Just ( UnquotedString remotename ) )
2020-09-14 20:49:33 +00:00
si = SeekInput []
2016-12-18 21:01:15 +00:00
performPairing :: RemoteName -> [ P2PAddress ] -> CommandPerform
performPairing remotename addrs = do
-- This note is displayed mainly so when magic wormhole
-- complains about possible protocol mismatches or other problems,
-- it's clear what's doing the complaining.
2016-12-18 21:31:02 +00:00
showNote " using Magic Wormhole "
2016-12-18 21:01:15 +00:00
next $ do
showOutput
2016-12-18 20:50:58 +00:00
r <- wormholePairing remotename addrs ui
case r of
PairSuccess -> return True
SendFailed -> do
warning " Failed sending data to pair. "
return False
ReceiveFailed -> do
warning " Failed receiving data from pair. "
return False
LinkFailed e -> do
filter out control characters in warning messages
Converted warning and similar to use StringContainingQuotedPath. Most
warnings are static strings, some do refer to filepaths that need to be
quoted, and others don't need quoting.
Note that, since quote filters out control characters of even
UnquotedString, this makes all warnings safe, even when an attacker
sneaks in a control character in some other way.
When json is being output, no quoting is done, since json gets its own
quoting.
This does, as a side effect, make warning messages in json output not
be indented. The indentation is only needed to offset warning messages
underneath the display of the file they apply to, so that's ok.
Sponsored-by: Brett Eisenberg on Patreon
2023-04-10 18:47:32 +00:00
warning $ UnquotedString $ " Failed linking to pair: " ++ e
2016-12-18 20:50:58 +00:00
return False
where
ui observer producer = do
ourcode <- Wormhole . waitCode observer
putStrLn " "
putStrLn $ " This repository's pairing code is: " ++
Wormhole . fromCode ourcode
putStrLn " "
theircode <- getcode ourcode
Wormhole . sendCode producer theircode
getcode ourcode = do
putStr " Enter the other repository's pairing code: "
hFlush stdout
l <- getLine
case Wormhole . toCode l of
Just code
2016-12-18 21:01:15 +00:00
| code /= ourcode -> do
2016-12-18 21:13:06 +00:00
putStrLn " Exchanging pairing data... "
2016-12-18 21:01:15 +00:00
return code
2016-12-18 20:50:58 +00:00
| otherwise -> do
2016-12-27 20:36:05 +00:00
putStrLn " Oops -- You entered this repository's pairing code. Enter the pairing code of the *other* repository. "
2016-12-18 20:50:58 +00:00
getcode ourcode
Nothing -> do
2016-12-24 20:56:56 +00:00
putStrLn " That does not look like a valiad pairing code. Try again... "
2016-12-18 20:50:58 +00:00
getcode ourcode
-- We generate half of the authtoken; the pair will provide
-- the other half.
newtype HalfAuthToken = HalfAuthToken T . Text
deriving ( Show )
data PairData = PairData HalfAuthToken [ P2PAddress ]
deriving ( Show )
serializePairData :: PairData -> String
serializePairData ( PairData ( HalfAuthToken ha ) addrs ) = unlines $
T . unpack ha : map formatP2PAddress addrs
deserializePairData :: String -> Maybe PairData
deserializePairData s = case lines s of
[] -> Nothing
( ha : l ) -> do
addrs <- mapM unformatP2PAddress l
return ( PairData ( HalfAuthToken ( T . pack ha ) ) addrs )
data PairingResult
= PairSuccess
| SendFailed
| ReceiveFailed
| LinkFailed String
wormholePairing
:: RemoteName
-> [ P2PAddress ]
-> ( Wormhole . CodeObserver -> Wormhole . CodeProducer -> IO () )
-> Annex PairingResult
wormholePairing remotename ouraddrs ui = do
ourhalf <- liftIO $ HalfAuthToken . fromAuthToken
<$> genAuthToken 64
let ourpairdata = PairData ourhalf ouraddrs
-- The magic wormhole interface only supports exchanging
-- files. Permissions of received files may allow others
-- to read them. So, set up a temp directory that only
-- we can read.
withTmpDir " pair " $ \ tmp -> do
2020-11-06 18:10:58 +00:00
liftIO $ void $ tryIO $ modifyFileMode ( toRawFilePath tmp ) $
2016-12-18 20:50:58 +00:00
removeModes otherGroupModes
let sendf = tmp </> " send "
let recvf = tmp </> " recv "
2020-11-06 18:10:58 +00:00
liftIO $ writeFileProtected ( toRawFilePath sendf ) $
2016-12-18 20:50:58 +00:00
serializePairData ourpairdata
observer <- liftIO Wormhole . mkCodeObserver
producer <- liftIO Wormhole . mkCodeProducer
void $ liftIO $ async $ ui observer producer
2017-02-03 19:06:17 +00:00
-- Provide an appid to magic wormhole, to avoid using
-- the same channels that other wormhole users use.
2021-12-30 16:16:22 +00:00
let appid = Wormhole . appId " git-annex.branchable.com/p2p-setup "
2016-12-18 20:50:58 +00:00
( sendres , recvres ) <- liftIO $
2021-12-30 16:16:22 +00:00
Wormhole . sendFile sendf observer appid
2016-12-18 20:50:58 +00:00
` concurrently `
2021-12-30 16:16:22 +00:00
Wormhole . receiveFile recvf producer appid
2020-11-24 16:38:12 +00:00
liftIO $ removeWhenExistsWith R . removeLink ( toRawFilePath sendf )
2016-12-18 20:50:58 +00:00
if sendres /= True
then return SendFailed
else if recvres /= True
then return ReceiveFailed
else do
r <- liftIO $ tryIO $
2016-12-24 18:46:31 +00:00
readFileStrict recvf
2016-12-18 20:50:58 +00:00
case r of
Left _e -> return ReceiveFailed
Right s -> maybe
( return ReceiveFailed )
( finishPairing 100 remotename ourhalf )
( deserializePairData s )
-- | Allow the peer we're pairing with to authenticate to us,
-- using an authtoken constructed from the two HalfAuthTokens.
-- Connect to the peer we're pairing with, and try to link to them.
--
-- Multiple addresses may have been received for the peer. This only
-- makes a link to one address.
--
-- Since we're racing the peer as they do the same, the first try is likely
-- to fail to authenticate. Can retry any number of times, to avoid the
-- users needing to redo the whole process.
finishPairing :: Int -> RemoteName -> HalfAuthToken -> PairData -> Annex PairingResult
finishPairing retries remotename ( HalfAuthToken ourhalf ) ( PairData ( HalfAuthToken theirhalf ) theiraddrs ) = do
case ( toAuthToken ( ourhalf <> theirhalf ) , toAuthToken ( theirhalf <> ourhalf ) ) of
( Just ourauthtoken , Just theirauthtoken ) -> do
2016-12-18 21:13:06 +00:00
liftIO $ putStrLn $ " Successfully exchanged pairing data. Connecting to " ++ remotename ++ " ... "
2016-12-18 20:50:58 +00:00
storeP2PAuthToken ourauthtoken
go retries theiraddrs theirauthtoken
_ -> return ReceiveFailed
where
go 0 [] _ = return $ LinkFailed $ " Unable to connect to " ++ remotename ++ " . "
go n [] theirauthtoken = do
liftIO $ threadDelaySeconds ( Seconds 2 )
liftIO $ putStrLn $ " Unable to connect to " ++ remotename ++ " . Retrying... "
go ( n - 1 ) theiraddrs theirauthtoken
go n ( addr : rest ) theirauthtoken = do
r <- setupLink remotename ( P2PAddressAuth addr theirauthtoken )
case r of
LinkSuccess -> return PairSuccess
_ -> go n rest theirauthtoken
data LinkResult
= LinkSuccess
| ConnectionError String
| AuthenticationError String
setupLink :: RemoteName -> P2PAddressAuth -> Annex LinkResult
setupLink remotename ( P2PAddressAuth addr authtoken ) = do
g <- Annex . gitRepo
git-annex-shell: block relay requests
connRepo is only used when relaying git upload-pack and receive-pack.
That's only supposed to be used when git-annex-remotedaemon is serving
git-remote-tor-annex connections over tor. But, it was always set, and
so could be used in other places possibly.
Fixed by making connRepo optional in the P2P protocol interface.
In Command.EnableTor, it's not needed, because it only speaks the
protocol in order to check that it's able to connect back to itself via
the hidden service. So changed that to pass Nothing rather than the git
repo.
In Remote.Helper.Ssh, it's connecting to git-annex-shell p2pstdio,
so is making the requests, so will never need connRepo.
In git-annex-shell p2pstdio, it was accepting git upload-pack and
receive-pack requests over the P2P protocol, even though nothing sent
them. This is arguably a security hole, particularly if the user has
set environment variables like GIT_ANNEX_SHELL_LIMITED to prevent
git push/pull via git-annex-shell.
2024-06-10 17:53:28 +00:00
cv <- liftIO $ tryNonAsync $ connectPeer ( Just g ) addr
2016-12-18 20:50:58 +00:00
case cv of
Left e -> return $ ConnectionError $ " Unable to connect with peer. Please check that the peer is connected to the network, and try again. ( " ++ show e ++ " ) "
Right conn -> do
u <- getUUID
2018-03-12 17:43:19 +00:00
let proto = P2P . auth u authtoken noop
2018-03-12 19:19:40 +00:00
runst <- liftIO $ mkRunState Client
go =<< liftIO ( runNetProto runst conn proto )
2016-12-18 20:50:58 +00:00
where
go ( Right ( Just theiruuid ) ) = do
ok <- inRepo $ Git . Command . runBool
[ Param " remote " , Param " add "
, Param remotename
, Param ( formatP2PAddress addr )
]
when ok $ do
2020-02-19 17:45:11 +00:00
storeUUIDIn ( remoteAnnexConfig remotename " uuid " ) theiruuid
2016-12-18 20:50:58 +00:00
storeP2PRemoteAuthToken addr authtoken
return LinkSuccess
go ( Right Nothing ) = return $ AuthenticationError " Unable to authenticate with peer. Please check the address and try again. "
2018-09-25 20:49:59 +00:00
go ( Left e ) = return $ AuthenticationError $ " Unable to authenticate with peer: " ++ describeProtoFailure e