unified AuthToken type between webapp and tor

This commit is contained in:
Joey Hess 2016-11-22 14:18:34 -04:00
parent 57a9484fbc
commit af4d919793
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
10 changed files with 120 additions and 45 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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"

View file

@ -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
View 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

View file

@ -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 ()

View file

@ -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