diff options
| -rw-r--r-- | Assistant/Threads/WebApp.hs | 3 | ||||
| -rw-r--r-- | CmdLine/GitRemoteTorAnnex.hs | 3 | ||||
| -rw-r--r-- | Remote/Helper/P2P.hs | 14 | ||||
| -rw-r--r-- | Remote/Helper/Tor.hs | 12 | ||||
| -rw-r--r-- | Utility/AuthToken.hs | 99 | ||||
| -rw-r--r-- | Utility/WebApp.hs | 25 | ||||
| -rw-r--r-- | git-annex.cabal | 5 |
7 files changed, 117 insertions, 44 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index f9a456f35..576feb5f0 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -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 diff --git a/CmdLine/GitRemoteTorAnnex.hs b/CmdLine/GitRemoteTorAnnex.hs index f3c3a81ae..3282cc081 100644 --- a/CmdLine/GitRemoteTorAnnex.hs +++ b/CmdLine/GitRemoteTorAnnex.hs @@ -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 diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs index eaa534fbe..9d9a3847b 100644 --- a/Remote/Helper/P2P.hs +++ b/Remote/Helper/P2P.hs @@ -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" diff --git a/Remote/Helper/Tor.hs b/Remote/Helper/Tor.hs index e91083362..25d192023 100644 --- a/Remote/Helper/Tor.hs +++ b/Remote/Helper/Tor.hs @@ -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" diff --git a/Utility/AuthToken.hs b/Utility/AuthToken.hs new file mode 100644 index 000000000..191b4f5c9 --- /dev/null +++ b/Utility/AuthToken.hs @@ -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 diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 63ca33520..a90772b10 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -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 () diff --git a/git-annex.cabal b/git-annex.cabal index 751bd4bd4..94d1ccf9c 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -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 |