From ea17e9c2a3350ba670f95a6fa0ce7716adfa4176 Mon Sep 17 00:00:00 2001 From: Igor Pashev Date: Fri, 25 Nov 2016 23:40:29 +0300 Subject: Make sure all HTTP headers are UTF8-encoded Especially X-Family-Name, X-Given-Name. Since we get all the data from JSON and JSON is in UTF8 by default RFC 7159, we are safe. Refactored to make it less error-prone and to get as small number of encoding/decoding as possible. --- README.md | 5 +++- src/Sproxy/Application.hs | 48 +++++++++++++++++-------------- src/Sproxy/Application/Cookie.hs | 45 +++++++++++++++++++++++++---- src/Sproxy/Application/OAuth2/Common.hs | 3 +- src/Sproxy/Application/OAuth2/Google.hs | 15 ++++++---- src/Sproxy/Application/OAuth2/LinkedIn.hs | 19 ++++++------ src/Sproxy/Server/DB.hs | 8 ++---- 7 files changed, 94 insertions(+), 49 deletions(-) diff --git a/README.md b/README.md index 0b37443..fcb57cc 100644 --- a/README.md +++ b/README.md @@ -126,9 +126,12 @@ Likewise `readers` have no access to e.g. `/wiki/edit/delete_everything.php`. HTTP headers passed to the back-end server ------------------------------------------ +All Sproxy headers are UTF8-encoded. + + header | value -------------------- | ----- -`From:` | visitor's email address +`From:` | visitor's email address, lower case `X-Groups:` | all groups that granted access to this resource, separated by commas (see the note below) `X-Given-Name:` | the visitor's given (first) name `X-Family-Name:` | the visitor's family (last) name diff --git a/src/Sproxy/Application.hs b/src/Sproxy/Application.hs index 83c4b70..ad3bec7 100644 --- a/src/Sproxy/Application.hs +++ b/src/Sproxy/Application.hs @@ -11,7 +11,6 @@ import Blaze.ByteString.Builder.ByteString (fromByteString) import Control.Exception (Exception, Handler(..), SomeException, catches, displayException) import Data.ByteString (ByteString) import Data.ByteString as BS (break, intercalate) -import Data.Char (toLower) import Data.ByteString.Char8 (pack, unpack) import Data.ByteString.Lazy (fromStrict) import Data.Conduit (Flush(Chunk), mapOutput) @@ -44,7 +43,9 @@ import qualified Network.HTTP.Client as BE import qualified Network.Wai as W import qualified Web.Cookie as WC -import Sproxy.Application.Cookie (AuthCookie(..), AuthUser(..), cookieDecode, cookieEncode) +import Sproxy.Application.Cookie ( AuthCookie(..), AuthUser, + cookieDecode, cookieEncode, getEmail, getEmailUtf8, getFamilyNameUtf8, + getGivenNameUtf8 ) import Sproxy.Application.OAuth2.Common (OAuth2Client(..)) import Sproxy.Config(BackendConf(..)) import Sproxy.Server.DB (Database, userExists, userGroups) @@ -115,11 +116,11 @@ oauth2callback key db (provider, oa2c) be req resp = Left msg -> badRequest ("invalid state: " ++ msg) req resp Right path -> do au <- oauth2Authenticate oa2c code (redirectURL req provider) - let email = map toLower $ auEmail au - Log.info $ "login `" ++ email ++ "' by " ++ show provider + let email = getEmail au + Log.info $ "login " ++ show email ++ " by " ++ show provider exists <- userExists db email - if exists then authenticate key be au{auEmail = email} path req resp - else userNotFound email req resp + if exists then authenticate key be au path req resp + else userNotFound au req resp where param p = do (_, v) <- find ((==) p . fst) $ W.queryString req @@ -166,29 +167,31 @@ authenticate key be user path req resp = do authorize :: Database -> (AuthCookie, Cookies) -> W.Request -> IO (Maybe W.Request) authorize db (authCookie, otherCookies) req = do + let + user = acUser authCookie + domain = decodeUtf8 . fromJust $ W.requestHeaderHost req + email = getEmail user + emailUtf8 = getEmailUtf8 user + familyUtf8 = getFamilyNameUtf8 user + givenUtf8 = getGivenNameUtf8 user + method = decodeUtf8 $ W.requestMethod req + path = decodeUtf8 $ W.rawPathInfo req grps <- userGroups db email domain path method if null grps then return Nothing else do ip <- pack . fromJust . fst <$> getNameInfo [NI_NUMERICHOST] True False (W.remoteHost req) return . Just $ req { W.requestHeaders = toList $ - insert "From" (pack email) $ - insert "X-Groups" (BS.intercalate "," grps) $ - insert "X-Given-Name" given $ - insert "X-Family-Name" family $ + insert "From" emailUtf8 $ + insert "X-Groups" (BS.intercalate "," $ encodeUtf8 <$> grps) $ + insert "X-Given-Name" givenUtf8 $ + insert "X-Family-Name" familyUtf8 $ insert "X-Forwarded-Proto" "https" $ insertWith (flip combine) "X-Forwarded-For" ip $ setCookies otherCookies $ fromListWith combine $ W.requestHeaders req } where - user = acUser authCookie - email = auEmail user - given = pack $ auGivenName user - family = pack $ auFamilyName user - domain = decodeUtf8 . fromJust $ W.requestHeaderHost req - path = decodeUtf8 $ W.rawPathInfo req - method = decodeUtf8 $ W.requestMethod req combine a b = a <> "," <> b setCookies [] = delete hCookie setCookies cs = insert hCookie (toByteString . renderCookies $ cs) @@ -278,10 +281,10 @@ authenticationRequired key oa2 req resp = do forbidden :: AuthCookie -> W.Application forbidden ac req resp = do - Log.info $ "403 Forbidden (" ++ email ++ "): " ++ showReq req + Log.info $ "403 Forbidden: " ++ show email ++ ": " ++ showReq req resp $ W.responseLBS forbidden403 [(hContentType, "text/html; charset=utf-8")] page where - email = auEmail . acUser $ ac + email = getEmailUtf8 . acUser $ ac page = fromStrict [qc| @@ -298,11 +301,12 @@ forbidden ac req resp = do |] -userNotFound :: String -> W.Application -userNotFound email _ resp = do - Log.info $ "404 User not found (" ++ email ++ ")" +userNotFound :: AuthUser -> W.Application +userNotFound au _ resp = do + Log.info $ "404 User not found: " ++ show email resp $ W.responseLBS notFound404 [(hContentType, "text/html; charset=utf-8")] page where + email = getEmailUtf8 au page = fromStrict [qc| diff --git a/src/Sproxy/Application/Cookie.hs b/src/Sproxy/Application/Cookie.hs index 07cc162..a86f42a 100644 --- a/src/Sproxy/Application/Cookie.hs +++ b/src/Sproxy/Application/Cookie.hs @@ -1,20 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} module Sproxy.Application.Cookie ( AuthCookie(..) -, AuthUser(..) +, AuthUser , cookieDecode , cookieEncode +, getEmail +, getEmailUtf8 +, getFamilyNameUtf8 +, getGivenNameUtf8 +, newUser +, setFamilyName +, setGivenName ) where import Data.ByteString (ByteString) +import Data.Text (Text, toLower, strip) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Foreign.C.Types (CTime(..)) import qualified Data.Serialize as DS import qualified Sproxy.Application.State as State data AuthUser = AuthUser { - auEmail :: String -, auGivenName :: String -, auFamilyName :: String + auEmail :: ByteString +, auGivenName :: ByteString +, auFamilyName :: ByteString } data AuthCookie = AuthCookie { @@ -37,8 +47,33 @@ instance DS.Serialize AuthCookie where cookieDecode :: ByteString -> ByteString -> Either String AuthCookie cookieDecode key d = State.decode key d >>= DS.decode - cookieEncode :: ByteString -> AuthCookie -> ByteString cookieEncode key = State.encode key . DS.encode +getEmail :: AuthUser -> Text +getEmail = decodeUtf8 . auEmail + +getEmailUtf8 :: AuthUser -> ByteString +getEmailUtf8 = auEmail + +getGivenNameUtf8 :: AuthUser -> ByteString +getGivenNameUtf8 = auGivenName + +getFamilyNameUtf8 :: AuthUser -> ByteString +getFamilyNameUtf8 = auFamilyName + + +newUser :: Text -> AuthUser +newUser email = AuthUser { + auEmail = encodeUtf8 . toLower . strip $ email + , auGivenName = "" + , auFamilyName = "" + } + +setGivenName :: Text -> AuthUser -> AuthUser +setGivenName given au = au{ auGivenName = encodeUtf8 . strip $ given } + +setFamilyName :: Text -> AuthUser -> AuthUser +setFamilyName family au = au{ auFamilyName = encodeUtf8 . strip $ family } + diff --git a/src/Sproxy/Application/OAuth2/Common.hs b/src/Sproxy/Application/OAuth2/Common.hs index 07fb759..0324e62 100644 --- a/src/Sproxy/Application/OAuth2/Common.hs +++ b/src/Sproxy/Application/OAuth2/Common.hs @@ -8,6 +8,7 @@ module Sproxy.Application.OAuth2.Common ( import Control.Applicative (empty) import Data.Aeson (FromJSON, parseJSON, Value(Object), (.:)) import Data.ByteString(ByteString) +import Data.Text (Text) import Sproxy.Application.Cookie (AuthUser) @@ -29,7 +30,7 @@ type OAuth2Provider = (ByteString, ByteString) -> OAuth2Client -- and expires_in because we don't use them, *and* expires_in creates troubles: -- it's an integer from Google and string from LinkedIn (sic!) data AccessTokenBody = AccessTokenBody { - accessToken :: String + accessToken :: Text } deriving (Eq, Show) instance FromJSON AccessTokenBody where diff --git a/src/Sproxy/Application/OAuth2/Google.hs b/src/Sproxy/Application/OAuth2/Google.hs index 6b68f44..5a1834c 100644 --- a/src/Sproxy/Application/OAuth2/Google.hs +++ b/src/Sproxy/Application/OAuth2/Google.hs @@ -9,12 +9,13 @@ import Control.Exception (Exception, throwIO) import Data.Aeson (FromJSON, decode, parseJSON, Value(Object), (.:)) import Data.ByteString.Lazy (ByteString) import Data.Monoid ((<>)) +import Data.Text (Text, unpack) import Data.Typeable (Typeable) import Network.HTTP.Types (hContentType) import Network.HTTP.Types.URI (urlEncode) import qualified Network.HTTP.Conduit as H -import Sproxy.Application.Cookie (AuthUser(..)) +import Sproxy.Application.Cookie (newUser, setFamilyName, setGivenName) import Sproxy.Application.OAuth2.Common (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider) @@ -48,11 +49,13 @@ provider (client_id, client_secret) = case decode $ H.responseBody tresp of Nothing -> throwIO $ GoogleException tresp Just atResp -> do - ureq <- H.parseRequest $ "https://www.googleapis.com/oauth2/v1/userinfo?access_token=" ++ accessToken atResp + ureq <- H.parseRequest $ unpack ("https://www.googleapis.com/oauth2/v1/userinfo?access_token=" <> accessToken atResp) uresp <- H.httpLbs ureq mgr case decode $ H.responseBody uresp of Nothing -> throwIO $ GoogleException uresp - Just u -> return AuthUser { auEmail = email u, auGivenName = givenName u, auFamilyName = familyName u } + Just u -> return $ setFamilyName (familyName u) $ + setGivenName (givenName u) $ + newUser (email u) } @@ -64,9 +67,9 @@ instance Exception GoogleException data GoogleUserInfo = GoogleUserInfo { - email :: String -, givenName :: String -, familyName :: String + email :: Text +, givenName :: Text +, familyName :: Text } deriving (Eq, Show) instance FromJSON GoogleUserInfo where diff --git a/src/Sproxy/Application/OAuth2/LinkedIn.hs b/src/Sproxy/Application/OAuth2/LinkedIn.hs index b60afde..b35c566 100644 --- a/src/Sproxy/Application/OAuth2/LinkedIn.hs +++ b/src/Sproxy/Application/OAuth2/LinkedIn.hs @@ -7,15 +7,16 @@ module Sproxy.Application.OAuth2.LinkedIn ( import Control.Applicative (empty) import Control.Exception (Exception, throwIO) import Data.Aeson (FromJSON, decode, parseJSON, Value(Object), (.:)) -import Data.ByteString.Char8 (pack) import Data.ByteString.Lazy (ByteString) import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) import Data.Typeable (Typeable) import Network.HTTP.Types (hContentType) import Network.HTTP.Types.URI (urlEncode) import qualified Network.HTTP.Conduit as H -import Sproxy.Application.Cookie (AuthUser(..)) +import Sproxy.Application.Cookie (newUser, setFamilyName, setGivenName) import Sproxy.Application.OAuth2.Common (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider) @@ -50,14 +51,14 @@ provider (client_id, client_secret) = Just atResp -> do let ureq = (H.parseRequest_ "https://api.linkedin.com/v1/people/\ \~:(email-address,first-name,last-name)?format=json") { - H.requestHeaders = [ ("Authorization", "Bearer " <> pack (accessToken atResp)) ] + H.requestHeaders = [ ("Authorization", "Bearer " <> encodeUtf8 (accessToken atResp)) ] } uresp <- H.httpLbs ureq mgr case decode $ H.responseBody uresp of Nothing -> throwIO $ LinkedInException uresp - Just u -> return AuthUser { auEmail = emailAddress u - , auGivenName = firstName u - , auFamilyName = lastName u } + Just u -> return $ setFamilyName (lastName u) $ + setGivenName (firstName u) $ + newUser (emailAddress u) } @@ -69,9 +70,9 @@ instance Exception LinkedInException data LinkedInUserInfo = LinkedInUserInfo { - emailAddress :: String -, firstName :: String -, lastName :: String + emailAddress :: Text +, firstName :: Text +, lastName :: Text } deriving (Eq, Show) instance FromJSON LinkedInUserInfo where diff --git a/src/Sproxy/Server/DB.hs b/src/Sproxy/Server/DB.hs index b760afc..90e2abd 100644 --- a/src/Sproxy/Server/DB.hs +++ b/src/Sproxy/Server/DB.hs @@ -11,11 +11,9 @@ module Sproxy.Server.DB ( import Control.Concurrent (forkIO, threadDelay) import Control.Exception (SomeException, bracket, catch, finally) import Control.Monad (forever, void) -import Data.ByteString (ByteString) import Data.ByteString.Char8 (pack) import Data.Pool (Pool, createPool, withResource) import Data.Text (Text, toLower, unpack) -import Data.Text.Encoding (encodeUtf8) import Database.SQLite.Simple (NamedParam((:=))) import Text.InterpolatedString.Perl6 (q, qc) import qualified Database.PostgreSQL.Simple as PG @@ -52,7 +50,7 @@ start home ds = do return db -userExists :: Database -> String -> IO Bool +userExists :: Database -> Text -> IO Bool userExists db email = do r <- withResource db $ \c -> fmap SQLite.fromOnly <$> SQLite.queryNamed c "SELECT EXISTS (SELECT 1 FROM group_member WHERE :email LIKE email LIMIT 1)" @@ -60,9 +58,9 @@ userExists db email = do return $ head r -userGroups :: Database -> String -> Text -> Text -> Text -> IO [ByteString] +userGroups :: Database -> Text -> Text -> Text -> Text -> IO [Text] userGroups db email domain path method = - withResource db $ \c -> fmap (encodeUtf8 . SQLite.fromOnly) <$> SQLite.queryNamed c [q| + withResource db $ \c -> fmap SQLite.fromOnly <$> SQLite.queryNamed c [q| SELECT gm."group" FROM group_privilege gp JOIN group_member gm ON gm."group" = gp."group" WHERE :email LIKE gm.email AND :domain LIKE gp.domain -- cgit v1.2.3