diff options
| -rw-r--r-- | README.md | 72 | ||||
| -rw-r--r-- | sproxy2.cabal | 1 | ||||
| -rw-r--r-- | src/Sproxy/Application.hs | 37 | ||||
| -rw-r--r-- | src/Sproxy/Application/Access.hs | 23 | ||||
| -rw-r--r-- | src/Sproxy/Server/DB.hs | 43 |
5 files changed, 140 insertions, 36 deletions
@@ -140,32 +140,36 @@ Keep in mind that: - SQL wildcards (`_` and `%`) are supported for emails, paths (this _will_ change in future versions). -HTTP headers passed to the back-end server ------------------------------------------- +Checking access in a bunch +-------------------------- -All Sproxy headers are UTF8-encoded. +There is an API end-point for checking access rights in a single POST query: +`/.sproxy/access`. Users should be authenticated to use this end-point, +otherwise the respond will be HTTP 511. +The request body shall be a JSON object like this: -header | value --------------------- | ----- -`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 -`X-Forwarded-Proto:` | the visitor's protocol of an HTTP request, always `https` -`X-Forwarded-For` | the visitor's IP address (added to the end of the list if header is already present in client request) +```json +{ + "tag1": {"path": "/foo", "method": "GET"}, + "tag2": {"path": "/bar", "method": "GET"} +} +``` +And the respond will contain a JSON array with tag matching path and method +pairs allowed to the user. For example: -`X-Groups` denotes an intersection of the groups the visitor belongs to and the groups that granted access: +```sh +$ curl -d '{"foo": {"path":"/get", "method":"GET"}, "bar": {"path":"/post", "method":"POST"}}' -XPOST -k 'https://example.ru:8443/.sproxy/access' ... +["foo","bar"] -Visitor's groups | Granted groups | `X-Groups` ----------------- | -------------- | --------- -all | all, devops | all -all, devops | all | all -all, devops | all, devops | all,devops -all, devops | devops | devops -devops | all, devops | devops -devops | all | Access denied +$ curl -d '{"foo": {"path":"/get", "method":"POST"}, "bar": {"path":"/post", "method":"POST"}}' -XPOST -k 'https://example.ru:8443/.sproxy/access' ... +["bar"] + +$ curl -d '{"foo": {"path":"/", "method":"POST"}, "bar": {"path":"/post", "method":"GET"}}' -XPOST -k 'https://example.ru:8443/.sproxy/access' ... +[] + +``` Logout @@ -188,6 +192,34 @@ Disallow: / ``` +HTTP headers passed to the back-end server +------------------------------------------ + +All Sproxy headers are UTF8-encoded. + + +header | value +-------------------- | ----- +`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 +`X-Forwarded-Proto:` | the visitor's protocol of an HTTP request, always `https` +`X-Forwarded-For` | the visitor's IP address (added to the end of the list if header is already present in client request) + + +`X-Groups` denotes an intersection of the groups the visitor belongs to and the groups that granted access: + +Visitor's groups | Granted groups | `X-Groups` +---------------- | -------------- | --------- +all | all, devops | all +all, devops | all | all +all, devops | all, devops | all,devops +all, devops | devops | devops +devops | all, devops | devops +devops | all | Access denied + + Requirements ============ Sproxy2 is written in Haskell with [GHC](http://www.haskell.org/ghc/). diff --git a/sproxy2.cabal b/sproxy2.cabal index ca55701..60179d1 100644 --- a/sproxy2.cabal +++ b/sproxy2.cabal @@ -32,6 +32,7 @@ executable sproxy2 main-is: Main.hs other-modules: Sproxy.Application + Sproxy.Application.Access Sproxy.Application.Cookie Sproxy.Application.OAuth2 Sproxy.Application.OAuth2.Common diff --git a/src/Sproxy/Application.hs b/src/Sproxy/Application.hs index 7376657..5de9474 100644 --- a/src/Sproxy/Application.hs +++ b/src/Sproxy/Application.hs @@ -27,7 +27,7 @@ import Data.Word8 (_colon) import Foreign.C.Types (CTime(..)) import Network.HTTP.Client.Conduit (bodyReaderSource) import Network.HTTP.Conduit (requestBodySourceChunkedIO, requestBodySourceIO) -import Network.HTTP.Types (RequestHeaders, ResponseHeaders, methodGet) +import Network.HTTP.Types (RequestHeaders, ResponseHeaders, methodGet, methodPost) import Network.HTTP.Types.Header ( hConnection, hContentLength, hContentType, hCookie, hLocation, hTransferEncoding ) import Network.HTTP.Types.Status ( Status(..), badRequest400, forbidden403, found302, @@ -39,6 +39,7 @@ import System.FilePath.Glob (Pattern, match) import System.Posix.Time (epochTime) import Text.InterpolatedString.Perl6 (qc) import Web.Cookie (Cookies, parseCookies, renderCookies) +import qualified Data.Aeson as JSON import qualified Network.HTTP.Client as BE import qualified Network.Wai as W import qualified Web.Cookie as WC @@ -48,7 +49,7 @@ import Sproxy.Application.Cookie ( AuthCookie(..), AuthUser, getGivenNameUtf8 ) import Sproxy.Application.OAuth2.Common (OAuth2Client(..)) import Sproxy.Config(BackendConf(..)) -import Sproxy.Server.DB (Database, userExists, userGroups) +import Sproxy.Server.DB (Database, userAccess, userExists, userGroups) import qualified Sproxy.Application.State as State import qualified Sproxy.Logging as Log @@ -81,12 +82,22 @@ sproxy key db oa2 backends = logException $ \req resp -> do ["robots.txt"] -> get robots req resp (".sproxy":proxy) -> case proxy of + ["logout"] -> get (logout key cookieName cookieDomain) req resp + ["oauth2", provider] -> case HM.lookup provider oa2 of Nothing -> notFound "OAuth2 provider" req resp Just oa2c -> get (oauth2callback key db (provider, oa2c) be) req resp + + ["access"] -> do + now <- Just <$> epochTime + case extractCookie key now cookieName req of + Nothing -> authenticationRequired key oa2 req resp + Just (authCookie, _) -> post (checkAccess db authCookie) req resp + _ -> notFound "proxy" req resp + _ -> do now <- Just <$> epochTime case extractCookie key now cookieName req of @@ -195,6 +206,20 @@ authorize db (authCookie, otherCookies) req = do setCookies cs = insert hCookie (toByteString . renderCookies $ cs) +checkAccess :: Database -> AuthCookie -> W.Application +checkAccess db authCookie req resp = do + let email = getEmail . acUser $ authCookie + domain = decodeUtf8 . fromJust $ requestDomain req + body <- W.strictRequestBody req + case JSON.eitherDecode' body of + Left err -> badRequest err req resp + Right inq -> do + Log.debug $ "access <<< " ++ show inq + tags <- userAccess db email domain inq + Log.debug $ "access >>> " ++ show tags + resp $ W.responseLBS ok200 [(hContentType, "application/json")] (JSON.encode tags) + + -- XXX If something seems strange, think about HTTP/1.1 <-> HTTP/1.0. -- FIXME For HTTP/1.0 backends we might need an option -- FIXME in config file. HTTP Client does HTTP/1.1 by default. @@ -380,6 +405,14 @@ get app req resp resp $ W.responseLBS methodNotAllowed405 [("Allow", "GET")] "Method Not Allowed" +post :: W.Middleware +post app req resp + | W.requestMethod req == methodPost = app req resp + | otherwise = do + Log.warn $ "405 Method Not Allowed: " ++ showReq req + resp $ W.responseLBS methodNotAllowed405 [("Allow", "POST")] "Method Not Allowed" + + redirectURL :: W.Request -> Text -> ByteString redirectURL req provider = "https://" <> fromJust (W.requestHeaderHost req) diff --git a/src/Sproxy/Application/Access.hs b/src/Sproxy/Application/Access.hs new file mode 100644 index 0000000..d8984ee --- /dev/null +++ b/src/Sproxy/Application/Access.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module Sproxy.Application.Access ( + Inquiry +, Question(..) +) where + +import Data.Aeson (FromJSON) +import Data.HashMap.Strict (HashMap) +import Data.Text (Text) +import GHC.Generics (Generic) + + +data Question = Question { + path :: Text +, method :: Text +} deriving (Generic, Show) + +instance FromJSON Question + +type Inquiry = HashMap Text Question + diff --git a/src/Sproxy/Server/DB.hs b/src/Sproxy/Server/DB.hs index b07a0a0..662a9c7 100644 --- a/src/Sproxy/Server/DB.hs +++ b/src/Sproxy/Server/DB.hs @@ -3,6 +3,7 @@ module Sproxy.Server.DB ( Database , DataSource(..) +, userAccess , userExists , userGroups , start @@ -10,18 +11,20 @@ module Sproxy.Server.DB ( import Control.Concurrent (forkIO, threadDelay) import Control.Exception (SomeException, bracket, catch, finally) -import Control.Monad (forever, void) +import Control.Monad (filterM, forever, void) import Data.ByteString.Char8 (pack) import Data.Pool (Pool, createPool, withResource) import Data.Text (Text, toLower, unpack) import Data.Yaml (decodeFileEither) import Database.SQLite.Simple (NamedParam((:=))) import Text.InterpolatedString.Perl6 (q, qc) +import qualified Data.HashMap.Strict as HM import qualified Database.PostgreSQL.Simple as PG import qualified Database.SQLite.Simple as SQLite import Sproxy.Server.DB.DataFile ( DataFile(..), GroupMember(..), GroupPrivilege(..), PrivilegeRule(..) ) +import qualified Sproxy.Application.Access as A import qualified Sproxy.Logging as Log @@ -61,19 +64,19 @@ userExists db email = do return $ head r -userGroups :: Database -> Text -> Text -> Text -> Text -> IO [Text] -userGroups db email domain path method = - 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 gp.domain = :domain - AND gp.privilege IN ( - SELECT privilege FROM privilege_rule - WHERE domain = :domain - AND :path LIKE path - AND method = :method - ORDER BY length(path) - length(replace(path, '/', '')) DESC LIMIT 1 - ) +userGroups_ :: SQLite.Connection -> Text -> Text -> Text -> Text -> IO [Text] +userGroups_ c email domain path method = + 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 gp.domain = :domain + AND gp.privilege IN ( + SELECT privilege FROM privilege_rule + WHERE domain = :domain + AND :path LIKE path + AND method = :method + ORDER BY length(path) - length(replace(path, '/', '')) DESC LIMIT 1 + ) |] [ ":email" := email -- XXX always in lower case , ":domain" := toLower domain , ":path" := path @@ -81,6 +84,18 @@ userGroups db email domain path method = ] +userAccess :: Database -> Text -> Text -> A.Inquiry -> IO [Text] +userAccess db email domain inq = do + let permitted c (_, qn) = + not . null <$> userGroups_ c email domain (A.path qn) (A.method qn) + map fst <$> withResource db (\c -> filterM (permitted c) (HM.toList inq)) + + +userGroups :: Database -> Text -> Text -> Text -> Text -> IO [Text] +userGroups db email domain path method = + withResource db $ \c -> userGroups_ c email domain path method + + populate :: Database -> Maybe DataSource -> IO () populate db Nothing = do |