2016-11-30 18:35:24 +00:00
|
|
|
{- P2P authtokens
|
2016-11-22 18:37:19 +00:00
|
|
|
-
|
|
|
|
- Copyright 2016 Joey Hess <id@joeyh.name>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module P2P.Auth where
|
|
|
|
|
2016-11-30 18:35:24 +00:00
|
|
|
import Annex.Common
|
|
|
|
import Creds
|
2016-11-30 19:14:54 +00:00
|
|
|
import P2P.Address
|
2016-11-22 18:37:19 +00:00
|
|
|
import Utility.AuthToken
|
2016-11-30 19:14:54 +00:00
|
|
|
import Utility.Tor
|
2016-11-30 19:26:16 +00:00
|
|
|
import Utility.Env
|
2016-11-22 18:37:19 +00:00
|
|
|
|
|
|
|
import qualified Data.Text as T
|
|
|
|
|
2016-11-30 18:35:24 +00:00
|
|
|
-- | Load authtokens that are accepted by this repository.
|
|
|
|
loadP2PAuthTokens :: Annex AllowedAuthTokens
|
|
|
|
loadP2PAuthTokens = allowedAuthTokens <$> loadP2PAuthTokens'
|
2016-11-22 18:37:19 +00:00
|
|
|
|
2016-11-30 18:35:24 +00:00
|
|
|
loadP2PAuthTokens' :: Annex [AuthToken]
|
|
|
|
loadP2PAuthTokens' = mapMaybe toAuthToken
|
|
|
|
. map T.pack
|
|
|
|
. lines
|
|
|
|
. fromMaybe []
|
|
|
|
<$> readCacheCreds p2pAuthCredsFile
|
2016-11-22 18:37:19 +00:00
|
|
|
|
2016-11-30 19:14:54 +00:00
|
|
|
-- | Stores an AuthToken, making it be accepted by this repository.
|
2016-11-30 18:35:24 +00:00
|
|
|
storeP2PAuthToken :: AuthToken -> Annex ()
|
|
|
|
storeP2PAuthToken t = do
|
|
|
|
ts <- loadP2PAuthTokens'
|
|
|
|
unless (t `elem` ts) $ do
|
|
|
|
let d = unlines $ map (T.unpack . fromAuthToken) (t:ts)
|
|
|
|
writeCacheCreds d p2pAuthCredsFile
|
|
|
|
|
|
|
|
p2pAuthCredsFile :: FilePath
|
|
|
|
p2pAuthCredsFile = "p2pauth"
|
2016-11-30 19:14:54 +00:00
|
|
|
|
|
|
|
-- | Loads the AuthToken to use when connecting with a given P2P address.
|
2016-11-30 19:26:16 +00:00
|
|
|
--
|
|
|
|
-- It's loaded from the first line of the creds file, but
|
|
|
|
-- GIT_ANNEX_P2P_AUTHTOKEN overrides.
|
2016-11-30 19:14:54 +00:00
|
|
|
loadP2PRemoteAuthToken :: P2PAddress -> Annex (Maybe AuthToken)
|
2016-11-30 19:26:16 +00:00
|
|
|
loadP2PRemoteAuthToken addr = maybe Nothing mk <$> getM id
|
|
|
|
[ liftIO $ getEnv "GIT_ANNEX_P2P_AUTHTOKEN"
|
|
|
|
, readCacheCreds (addressCredsFile addr)
|
|
|
|
]
|
|
|
|
where
|
|
|
|
mk = toAuthToken . T.pack . takeWhile (/= '\n')
|
|
|
|
|
|
|
|
p2pAuthTokenEnv :: String
|
|
|
|
p2pAuthTokenEnv = "GIT_ANNEX_P2P_AUTHTOKEN"
|
2016-11-30 19:14:54 +00:00
|
|
|
|
|
|
|
-- | Stores the AuthToken o use when connecting with a given P2P address.
|
|
|
|
storeP2PRemoteAuthToken :: P2PAddress -> AuthToken -> Annex ()
|
|
|
|
storeP2PRemoteAuthToken addr t = writeCacheCreds
|
|
|
|
(T.unpack $ fromAuthToken t)
|
|
|
|
(addressCredsFile addr)
|
|
|
|
|
|
|
|
addressCredsFile :: P2PAddress -> FilePath
|
|
|
|
-- 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.
|
|
|
|
addressCredsFile (TorAnnex (OnionAddress onionaddr) _port) = onionaddr
|