f631bc9e56This is for p2p-annex:: urls that will use the new generic P2P transport. In addressCredsFile, threw in an url encoding of any non-alphanumeric characters that are in the address. This is to avoid any possible path traversal attacks via a p2p-annex:: url, since the address part of it could contain any characters. And, went ahead and did the same url encoding of tor-annex:: urls, even though tor onion addresses are all alphanumerics, on the off chance that might avoid a similar problem. (It does not seem likely enough to treat it as a security hole.)
100 lines
2.9 KiB
Haskell
100 lines
2.9 KiB
Haskell
{- P2P authtokens
|
|
-
|
|
- Copyright 2016-2025 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module P2P.Auth where
|
|
|
|
import Annex.Common
|
|
import Creds
|
|
import P2P.Address
|
|
import Utility.AuthToken
|
|
import Utility.Tor
|
|
import Utility.Env
|
|
|
|
import Network.URI
|
|
import Data.Char
|
|
import qualified Data.Text as T
|
|
|
|
-- | Load authtokens that are accepted by this repository for tor.
|
|
loadP2PAuthTokensTor :: Annex AllowedAuthTokens
|
|
loadP2PAuthTokensTor = allowedAuthTokens
|
|
. map fst . filter istor
|
|
<$> loadP2PAuthTokens'
|
|
where
|
|
istor (_, Nothing) = True
|
|
istor _ = False
|
|
|
|
-- | Load authtokens that are accepted for a given P2PAddress.
|
|
loadP2PAuthTokens :: P2PAddress -> Annex AllowedAuthTokens
|
|
loadP2PAuthTokens addr = allowedAuthTokens
|
|
. map fst . filter ((== Just addr) . snd)
|
|
<$> loadP2PAuthTokens'
|
|
|
|
loadP2PAuthTokens' :: Annex [(AuthToken, Maybe P2PAddress)]
|
|
loadP2PAuthTokens' = mapMaybe parse
|
|
. lines
|
|
. fromMaybe []
|
|
<$> readCreds p2pAuthCredsFile
|
|
where
|
|
parse l =
|
|
let (tok, addr) = separate (== ' ') l
|
|
in do
|
|
tok' <- toAuthToken (T.pack tok)
|
|
return (tok', unformatP2PAddress addr)
|
|
|
|
-- | Stores an AuthToken, making it be accepted by this repository.
|
|
storeP2PAuthToken :: P2PAddress -> AuthToken -> Annex ()
|
|
storeP2PAuthToken addr t = do
|
|
ts <- loadP2PAuthTokens'
|
|
unless (v `elem` ts) $ do
|
|
let d = unlines $ map fmt (v:ts)
|
|
writeCreds d p2pAuthCredsFile
|
|
where
|
|
v = case addr of
|
|
TorAnnex _ _ -> (t, Nothing)
|
|
_ -> (t, Just addr)
|
|
|
|
fmt (tok, Nothing) = T.unpack (fromAuthToken tok)
|
|
fmt (tok, Just addr') = T.unpack (fromAuthToken tok)
|
|
++ " " ++ formatP2PAddress addr'
|
|
|
|
|
|
p2pAuthCredsFile :: OsPath
|
|
p2pAuthCredsFile = literalOsPath "p2pauth"
|
|
|
|
-- | Loads the AuthToken to use when connecting with a given P2P address.
|
|
--
|
|
-- It's loaded from the first line of the creds file, but
|
|
-- GIT_ANNEX_P2P_AUTHTOKEN overrides.
|
|
loadP2PRemoteAuthToken :: P2PAddress -> Annex (Maybe AuthToken)
|
|
loadP2PRemoteAuthToken addr = maybe Nothing mk <$> getM id
|
|
[ liftIO $ getEnv "GIT_ANNEX_P2P_AUTHTOKEN"
|
|
, readCreds (addressCredsFile addr)
|
|
]
|
|
where
|
|
mk = toAuthToken . T.pack . takeWhile (/= '\n')
|
|
|
|
p2pAuthTokenEnv :: String
|
|
p2pAuthTokenEnv = "GIT_ANNEX_P2P_AUTHTOKEN"
|
|
|
|
-- | Stores the AuthToken to use when connecting with a given P2P address.
|
|
storeP2PRemoteAuthToken :: P2PAddress -> AuthToken -> Annex ()
|
|
storeP2PRemoteAuthToken addr t = writeCreds
|
|
(T.unpack $ fromAuthToken t)
|
|
(addressCredsFile addr)
|
|
|
|
-- | Unusual characters in the address are url encoded.
|
|
addressCredsFile :: P2PAddress -> OsPath
|
|
addressCredsFile addr = toOsPath $ escapeURIString isAlphaNum $ case addr of
|
|
-- We can omit the port and just use the onion address for the
|
|
-- creds file, because any given tor hidden service runs on a
|
|
-- single port and has a unique onion address.
|
|
TorAnnex (OnionAddress onionaddr) _port ->
|
|
onionaddr
|
|
P2PAnnex (P2PNetName netname) (UnderlyingP2PAddress address) ->
|
|
netname ++ ":" ++ address
|