unified AuthToken type between webapp and tor
This commit is contained in:
parent
57a9484fbc
commit
af4d919793
10 changed files with 120 additions and 45 deletions
|
@ -39,6 +39,7 @@ import Assistant.WebApp.OtherRepos
|
|||
import Assistant.WebApp.Repair
|
||||
import Assistant.Types.ThreadedMonad
|
||||
import Utility.WebApp
|
||||
import Utility.AuthToken
|
||||
import Utility.Tmp
|
||||
import Utility.FileMode
|
||||
import Git
|
||||
|
@ -75,7 +76,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost
|
|||
#endif
|
||||
webapp <- WebApp
|
||||
<$> pure assistantdata
|
||||
<*> genAuthToken
|
||||
<*> genAuthToken 512
|
||||
<*> getreldir
|
||||
<*> pure staticRoutes
|
||||
<*> pure postfirstrun
|
||||
|
|
|
@ -14,7 +14,7 @@ import Assistant.WebApp.Types
|
|||
import Assistant.Common
|
||||
import Utility.NotificationBroadcaster
|
||||
import Utility.Yesod
|
||||
import Utility.WebApp
|
||||
import Utility.AuthToken
|
||||
|
||||
import Data.Text (Text)
|
||||
import Control.Concurrent
|
||||
|
|
|
@ -17,6 +17,7 @@ import Assistant.Types.Buddies
|
|||
import Utility.NotificationBroadcaster
|
||||
import Utility.Yesod
|
||||
import Utility.WebApp
|
||||
import Utility.AuthToken
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
|
|
@ -20,6 +20,7 @@ import Assistant.Ssh
|
|||
import Assistant.Pairing
|
||||
import Assistant.Types.Buddies
|
||||
import Utility.NotificationBroadcaster
|
||||
import Utility.AuthToken
|
||||
import Utility.WebApp
|
||||
import Utility.Yesod
|
||||
import Types.Transfer
|
||||
|
|
|
@ -14,6 +14,7 @@ import Remote.Helper.P2P
|
|||
import Remote.Helper.P2P.IO
|
||||
import Remote.Helper.Tor
|
||||
import Utility.Tor
|
||||
import Utility.AuthToken
|
||||
import Annex.UUID
|
||||
|
||||
run :: [String] -> IO ()
|
||||
|
@ -53,7 +54,7 @@ connectService address port service = do
|
|||
state <- Annex.new =<< Git.CurrentRepo.get
|
||||
Annex.eval state $ do
|
||||
authtoken <- fromMaybe nullAuthToken
|
||||
<$> getTorAuthToken address
|
||||
<$> getTorAuthTokenFor address
|
||||
myuuid <- getUUID
|
||||
g <- Annex.gitRepo
|
||||
h <- liftIO $ torHandle =<< connectHiddenService address port
|
||||
|
|
|
@ -12,6 +12,7 @@ module Remote.Helper.P2P where
|
|||
import qualified Utility.SimpleProtocol as Proto
|
||||
import Types.Key
|
||||
import Types.UUID
|
||||
import Utility.AuthToken
|
||||
import Utility.Applicative
|
||||
import Utility.PartialPrelude
|
||||
|
||||
|
@ -23,15 +24,6 @@ import System.Exit (ExitCode(..))
|
|||
import System.IO
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
|
||||
newtype AuthToken = AuthToken String
|
||||
deriving (Show)
|
||||
|
||||
mkAuthToken :: String -> Maybe AuthToken
|
||||
mkAuthToken = fmap AuthToken . headMaybe . lines
|
||||
|
||||
nullAuthToken :: AuthToken
|
||||
nullAuthToken = AuthToken ""
|
||||
|
||||
newtype Offset = Offset Integer
|
||||
deriving (Show)
|
||||
|
||||
|
@ -111,10 +103,6 @@ instance Proto.Serializable Len where
|
|||
serialize (Len n) = show n
|
||||
deserialize = Len <$$> readish
|
||||
|
||||
instance Proto.Serializable AuthToken where
|
||||
serialize (AuthToken s) = s
|
||||
deserialize = Just . AuthToken
|
||||
|
||||
instance Proto.Serializable Service where
|
||||
serialize UploadPack = "git-upload-pack"
|
||||
serialize ReceivePack = "git-receive-pack"
|
||||
|
|
|
@ -8,19 +8,23 @@
|
|||
module Remote.Helper.Tor where
|
||||
|
||||
import Annex.Common
|
||||
import Remote.Helper.P2P (mkAuthToken, AuthToken)
|
||||
import Utility.AuthToken
|
||||
import Creds
|
||||
import Utility.Tor
|
||||
import Utility.Env
|
||||
|
||||
import Network.Socket
|
||||
import qualified Data.Text as T
|
||||
|
||||
getTorAuthToken :: OnionAddress -> Annex (Maybe AuthToken)
|
||||
getTorAuthToken (OnionAddress onionaddress) =
|
||||
maybe Nothing mkAuthToken <$> getM id
|
||||
-- Read the first line of the creds file. Environment variable overrides.
|
||||
getTorAuthTokenFor :: OnionAddress -> Annex (Maybe AuthToken)
|
||||
getTorAuthTokenFor (OnionAddress onionaddress) =
|
||||
maybe Nothing mk <$> getM id
|
||||
[ liftIO $ getEnv torAuthTokenEnv
|
||||
, readCacheCreds onionaddress
|
||||
]
|
||||
where
|
||||
mk = toAuthToken . T.pack . takeWhile (/= '\n')
|
||||
|
||||
torAuthTokenEnv :: String
|
||||
torAuthTokenEnv = "GIT_ANNEX_TOR_AUTHTOKEN"
|
||||
|
|
99
Utility/AuthToken.hs
Normal file
99
Utility/AuthToken.hs
Normal file
|
@ -0,0 +1,99 @@
|
|||
{- authentication tokens
|
||||
-
|
||||
- Copyright 2016 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
module Utility.AuthToken (
|
||||
AuthToken,
|
||||
toAuthToken,
|
||||
fromAuthToken,
|
||||
nullAuthToken,
|
||||
genAuthToken,
|
||||
AllowedAuthTokens,
|
||||
allowedAuthTokens,
|
||||
isAllowedAuthToken,
|
||||
) where
|
||||
|
||||
import qualified Utility.SimpleProtocol as Proto
|
||||
import Utility.Hash
|
||||
|
||||
import Data.SecureMem
|
||||
import Data.Maybe
|
||||
import Data.Char
|
||||
import Data.Byteable
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import "crypto-api" Crypto.Random
|
||||
|
||||
-- | An AuthToken is stored in secue memory, with constant time comparison.
|
||||
--
|
||||
-- It can have varying length, depending on the security needs of the
|
||||
-- application.
|
||||
--
|
||||
-- To avoid decoding issues, and presentation issues, the content
|
||||
-- of an AuthToken is limited to ASCII characters a-z, and 0-9.
|
||||
-- This is enforced by all exported AuthToken constructors.
|
||||
newtype AuthToken = AuthToken SecureMem
|
||||
deriving (Show, Eq)
|
||||
|
||||
allowedChar :: Char -> Bool
|
||||
allowedChar c = isAsciiUpper c || isAsciiLower c || isDigit c
|
||||
|
||||
instance Proto.Serializable AuthToken where
|
||||
serialize = T.unpack . fromAuthToken
|
||||
deserialize = toAuthToken . T.pack
|
||||
|
||||
fromAuthToken :: AuthToken -> T.Text
|
||||
fromAuthToken (AuthToken t ) = TE.decodeLatin1 (toBytes t)
|
||||
|
||||
-- | Upper-case characters are lower-cased to make them fit in the allowed
|
||||
-- character set. This allows AuthTokens to be compared effectively
|
||||
-- case-insensitively.
|
||||
--
|
||||
-- Returns Nothing if any disallowed characters are present.
|
||||
toAuthToken :: T.Text -> Maybe AuthToken
|
||||
toAuthToken t
|
||||
| all allowedChar s = Just $ AuthToken $
|
||||
secureMemFromByteString $ TE.encodeUtf8 $ T.pack s
|
||||
| otherwise = Nothing
|
||||
where
|
||||
s = map toLower $ T.unpack t
|
||||
|
||||
-- | The empty AuthToken, for those times when you don't want any security.
|
||||
nullAuthToken :: AuthToken
|
||||
nullAuthToken = AuthToken $ secureMemFromByteString $ TE.encodeUtf8 T.empty
|
||||
|
||||
-- | Generates an AuthToken of a specified length. This is done by
|
||||
-- generating a random bytestring, hashing it with sha2 512, and truncating
|
||||
-- to the specified length.
|
||||
--
|
||||
-- That limits the maximum length to 128, but with 512 bytes of entropy,
|
||||
-- that should be sufficient for any application.
|
||||
genAuthToken :: Int -> IO AuthToken
|
||||
genAuthToken len = do
|
||||
g <- newGenIO :: IO SystemRandom
|
||||
return $
|
||||
case genBytes 512 g of
|
||||
Left e -> error $ "failed to generate auth token: " ++ show e
|
||||
Right (s, _) -> fromMaybe (error "auth token encoding failed") $
|
||||
toAuthToken $ T.pack $ take len $
|
||||
show $ sha2_512 $ L.fromChunks [s]
|
||||
|
||||
-- | For when several AuthTokens are allowed to be used.
|
||||
newtype AllowedAuthTokens = AllowedAuthTokens [AuthToken]
|
||||
|
||||
allowedAuthTokens :: [AuthToken] -> AllowedAuthTokens
|
||||
allowedAuthTokens = AllowedAuthTokens
|
||||
|
||||
-- | Note that every item in the list is checked, even if the first one
|
||||
-- is allowed, so that comparison is constant-time.
|
||||
isAllowedAuthToken :: AuthToken -> AllowedAuthTokens -> Bool
|
||||
isAllowedAuthToken t (AllowedAuthTokens l) = go False l
|
||||
where
|
||||
go ok [] = ok
|
||||
go ok (i:is)
|
||||
| t == i = go True is
|
||||
| otherwise = go ok is
|
|
@ -12,7 +12,7 @@ module Utility.WebApp where
|
|||
import Common
|
||||
import Utility.Tmp
|
||||
import Utility.FileMode
|
||||
import Utility.Hash
|
||||
import Utility.AuthToken
|
||||
|
||||
import qualified Yesod
|
||||
import qualified Network.Wai as Wai
|
||||
|
@ -23,7 +23,6 @@ import qualified Data.CaseInsensitive as CI
|
|||
import Network.Socket
|
||||
import "crypto-api" Crypto.Random
|
||||
import qualified Web.ClientSession as CS
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
|
@ -31,8 +30,6 @@ import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
|||
import Blaze.ByteString.Builder (Builder)
|
||||
import Control.Arrow ((***))
|
||||
import Control.Concurrent
|
||||
import Data.SecureMem
|
||||
import Data.Byteable
|
||||
#ifdef __ANDROID__
|
||||
import Data.Endian
|
||||
#endif
|
||||
|
@ -159,24 +156,6 @@ webAppSessionBackend _ = do
|
|||
Just . Yesod.clientSessionBackend key . fst
|
||||
<$> Yesod.clientSessionDateCacher timeout
|
||||
|
||||
type AuthToken = SecureMem
|
||||
|
||||
toAuthToken :: T.Text -> AuthToken
|
||||
toAuthToken = secureMemFromByteString . TE.encodeUtf8
|
||||
|
||||
fromAuthToken :: AuthToken -> T.Text
|
||||
fromAuthToken = TE.decodeLatin1 . toBytes
|
||||
|
||||
{- Generates a random sha2_512 string, encapsulated in a SecureMem,
|
||||
- suitable to be used for an authentication secret. -}
|
||||
genAuthToken :: IO AuthToken
|
||||
genAuthToken = do
|
||||
g <- newGenIO :: IO SystemRandom
|
||||
return $
|
||||
case genBytes 512 g of
|
||||
Left e -> error $ "failed to generate auth token: " ++ show e
|
||||
Right (s, _) -> toAuthToken $ T.pack $ show $ sha2_512 $ L.fromChunks [s]
|
||||
|
||||
{- A Yesod isAuthorized method, which checks the auth cgi parameter
|
||||
- against a token extracted from the Yesod application.
|
||||
-
|
||||
|
@ -193,7 +172,7 @@ checkAuthToken extractAuthToken r predicate
|
|||
webapp <- Yesod.getYesod
|
||||
req <- Yesod.getRequest
|
||||
let params = Yesod.reqGetParams req
|
||||
if (toAuthToken <$> lookup "auth" params) == Just (extractAuthToken webapp)
|
||||
if (toAuthToken =<< lookup "auth" params) == Just (extractAuthToken webapp)
|
||||
then return Yesod.Authorized
|
||||
else Yesod.sendResponseStatus unauthorized401 ()
|
||||
|
||||
|
|
|
@ -368,7 +368,8 @@ Executable git-annex
|
|||
unordered-containers,
|
||||
feed,
|
||||
regex-tdfa,
|
||||
socks
|
||||
socks,
|
||||
securemem
|
||||
CC-Options: -Wall
|
||||
GHC-Options: -Wall -fno-warn-tabs
|
||||
Extensions: PackageImports
|
||||
|
@ -472,7 +473,6 @@ Executable git-annex
|
|||
clientsession,
|
||||
template-haskell,
|
||||
shakespeare (>= 2.0.0),
|
||||
securemem,
|
||||
byteable
|
||||
CPP-Options: -DWITH_WEBAPP
|
||||
|
||||
|
@ -989,6 +989,7 @@ Executable git-annex
|
|||
Upgrade.V4
|
||||
Upgrade.V5
|
||||
Utility.Applicative
|
||||
Utility.AuthToken
|
||||
Utility.Base64
|
||||
Utility.Batch
|
||||
Utility.Bloom
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue