diff options
author | Igor Pashev <pashev.igor@gmail.com> | 2016-10-27 22:57:34 +0300 |
---|---|---|
committer | Igor Pashev <pashev.igor@gmail.com> | 2016-11-19 23:29:43 +0300 |
commit | 4a9f329a6ea9bfa03352ca0d9dd1d556b93bec36 (patch) | |
tree | ec49e853364a61eb4c7c64b5f13b0153d21a4cc1 | |
download | sproxy2-4a9f329a6ea9bfa03352ca0d9dd1d556b93bec36.tar.gz |
Initial release (1.90.0)1.90.0
-rw-r--r-- | .gitignore | 7 | ||||
-rw-r--r-- | ChangeLog.md | 43 | ||||
-rw-r--r-- | LICENSE | 20 | ||||
-rw-r--r-- | README.md | 161 | ||||
-rw-r--r-- | Setup.hs | 2 | ||||
-rw-r--r-- | sproxy.sql | 168 | ||||
-rw-r--r-- | sproxy.yml.example | 139 | ||||
-rw-r--r-- | sproxy2.cabal | 72 | ||||
-rw-r--r-- | src/Main.hs | 37 | ||||
-rw-r--r-- | src/Sproxy/Application.hs | 372 | ||||
-rw-r--r-- | src/Sproxy/Application/Cookie.hs | 44 | ||||
-rw-r--r-- | src/Sproxy/Application/OAuth2.hs | 18 | ||||
-rw-r--r-- | src/Sproxy/Application/OAuth2/Common.hs | 39 | ||||
-rw-r--r-- | src/Sproxy/Application/OAuth2/Google.hs | 78 | ||||
-rw-r--r-- | src/Sproxy/Application/OAuth2/LinkedIn.hs | 83 | ||||
-rw-r--r-- | src/Sproxy/Application/State.hs | 30 | ||||
-rw-r--r-- | src/Sproxy/Config.hs | 88 | ||||
-rw-r--r-- | src/Sproxy/Logging.hs | 99 | ||||
-rw-r--r-- | src/Sproxy/Server.hs | 190 | ||||
-rw-r--r-- | src/Sproxy/Server/DB.hs | 189 |
20 files changed, 1879 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0c5653f --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +*.sqlite3* +*.swp +/.cabal-sandbox/ +/cabal-dev/ +/cabal.sandbox.config +/dist/ +sproxy.yml diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 index 0000000..208a845 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,43 @@ +For differences with the original Sproxy scroll down. + +1.90.0 (Preview Release) +======================== + +Sproxy2 is overhaul of original [Sproxy](https://github.com/zalora/sproxy) +(see also [Hackage](https://hackage.haskell.org/package/sproxy)). +Here are the key differences (with Sproxy 0.9.8): + + * Sproxy2 can work with remote PostgreSQL database. Quick access to the database is essential + as sproxy does it on every HTTP request. Sproxy2 pulls data into local SQLite3 database. + + * At this release Sproxy2 is compatible with Sproxy database with one exception: + SQL wildcards are not supported for HTTP methods. E. i. you have to change '%' in + the database to specific methods like GET, POST, etc. + + * OAuth2 callback URLs changed: Sproxy2 uses `/.sproxy/oauth2/:provider`, + e. g. `/.sproxy/oauth2/google`. Sproxy used `/sproxy/oauth2callback` for Google + and `/sproxy/oauth2callback/linkedin` for LinkedIn. + + * Sproxy2 does not allow login with email addresses not known to it. + + * Sproxy2: OAuth2 callback state is serialized, signed and passed base64-encoded. + Of course it's used to verify the request is legit. + + * Sproxy2: session cookie is serialized, signed and sent base64-encoded. + + * Path `/.sproxy` belongs to Sproxy2 completely. Anything under this path is never passed to backends. + + * Sproxy2 supports multiple backends. Routing is based on the Host HTTP header. + + * Sproxy2 uses [WAI](https://hackage.haskell.org/package/wai) / [Warp](https://hackage.haskell.org/package/warp) + for incoming connections. As a result Sproxy2 supports HTTP2. + + * Sproxy2 uses [HTTP Client](https://hackage.haskell.org/package/http-client) to talk to backends. + As a result Sproxy2 reuses backend connections instead of closing them after each request to the backend. + + * Sproxy2 optionally supports persistent key again (removed in Sproxy 0.9.2). + This can be used in load-balancing multiple Sproxy2 instances. + + * Configuration file has changed. It's still YAML, but some options are renamed, removed or added. + Have a look at well-documented [sproxy.yml.example](./sproxy.yml.example) + @@ -0,0 +1,20 @@ +Copyright (c) 2016, Zalora South East Asia Pte. Ltd + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..aa2f998 --- /dev/null +++ b/README.md @@ -0,0 +1,161 @@ +# Sproxy2 - HTTP proxy for authenticating users via OAuth2 + +## Motivation + +This is overhaul of original [Sproxy](https://hackage.haskell.org/package/sproxy). +See [ChangeLog.md](./ChangeLog.md) for the differences. + +Why use a proxy for doing OAuth2? Isn't that up to the application? + + * sproxy is secure by default. No requests make it to + the web server if they haven't been explicitly whitelisted. + * sproxy is independent. Any web application written in + any language can use it. + +## Use cases + + * Existing web applications with concept of roles. For example, + [Mediawiki](https://www.mediawiki.org), [Jenkins](https://jenkins.io), + [Icinga Web 2](https://www.icinga.org/products/icinga-web-2/). In + this case you configure Sproxy to allow unrestricted access + to the application for some groups defined by Sproxy. These + groups are mapped to the application roles. There is a [plugin for + Jenkins](https://wiki.jenkins-ci.org/display/JENKINS/Reverse+Proxy+Auth+Plugin) + which can be used for this. Mediawiki and Icinga Web 2 were also + successfully deployed in this way, though it required changes to their + source code. + + * New web applications designed to work specifically behind Sproxy. In this case + you define Sproxy rules to control access to the + application's API. It would likely be [a single-page + application](https://en.wikipedia.org/wiki/Single-page_application). + Examples are [MyWatch](https://hackage.haskell.org/package/mywatch) and + [Juan de la Cosa](https://hackage.haskell.org/package/juandelacosa) + +## How it works + +When an HTTP client makes a request, Sproxy checks for a *session cookie*. +If it doesn't exist (or it's invalid, expired), it responses with [HTTP +status 511](https://tools.ietf.org/html/rfc6585) with the page, where the +user can choose an [OAuth2](https://tools.ietf.org/html/rfc6749) provider to +authenticate with. Finally, we store the the email address in a session +cookie: signed with a hash to prevent tampering, set for HTTP only (to prevent +malicious JavaScript from reading it), and set it for secure (since we don't +want it traveling over plaintext HTTP connections). + +From that point on, when sproxy detects a valid session cookie it extracts the +email, checks it against the access rules, and relays the request to the +back-end server (if allowed). + + +## Logout + +Hitting the endpoint `/.sproxy/logout` will invalidate the session cookie. +The user will be redirected to `/` after logout. + + +## Robots + +Since all sproxied resources are private, it doesn't make sense for web +crawlers to try to index them. In fact, crawlers will index only the login +page. To prevent this, sproxy returns the following for `/robots.txt`: + +``` +User-agent: * +Disallow: / +``` + + +## Permissions system + +Permissions are stored in a PostgreSQL database. See sproxy.sql for details. +Here are the main concepts: + +- A `group` is identified by a name. Every group has + - members (identified by email address, through `group_member`) and + - associated privileges (through `group_privilege`). +- A `privilege` is identified by a name _and_ a domain. It has associated rules + (through `privilege_rule`) that define what the privilege gives access to. +- A `rule` is a combination of sql patterns for a `domain`, a `path` and an + HTTP `method`. A rule matches an HTTP request, if all of these components + match the respective attributes of the request. However of all the matching + rules only the rule with the longest `path` pattern will be used to determine + whether a user is allowed to perform a request. This is often a bit + surprising, please see the following example: + + +Do note that Sproxy2 fetches only `group_member`, `group_privilege` and `privilege_rule` +tables, because only these tables are used for authorization. The other tables +serve for data integrity. + + +### Privileges example + +Consider this `group_privilege` and `privilege_rule` relations: + +group | privilege | domain +---------------- | --------- | ----------------- +`readers` | `basic` | `wiki.example.com` +`readers` | `read` | `wiki.example.com` +`editors` | `basic` | `wiki.example.com` +`editors` | `read` | `wiki.example.com` +`editors` | `edit` | `wiki.example.com` +`administrators` | `basic` | `wiki.example.com` +`administrators` | `read` | `wiki.example.com` +`administrators` | `edit` | `wiki.example.com` +`administrators` | `admin` | `wiki.example.com` + +privilege | domain | path | method +----------- | ------------------ | -------------- | ------ +`basic` | `wiki.example.com` | `/%` | `GET` +`read` | `wiki.example.com` | `/wiki/%` | `GET` +`edit` | `wiki.example.com` | `/wiki/edit/%` | `GET` +`edit` | `wiki.example.com` | `/wiki/edit/%` | `POST` +`admin` | `wiki.example.com` | `/admin/%` | `GET` +`admin` | `wiki.example.com` | `/admin/%` | `POST` +`admin` | `wiki.example.com` | `/admin/%` | `DELETE` + +With this setup, everybody (that is `readers`, `editors` and `administrators`s) +will have access to e.g. `/imgs/logo.png` and `/favicon.ico`, but only +administrators will have access to `/admin/index.php`, because the longest +matching path pattern is `/admin/%` and only `administrator`s have the `admin` +privilege. + +Likewise `readers` have no access to e.g. `/wiki/edit/delete_everything.php`. + + +## HTTP headers passed to the back-end server: + +header | value +-------------------- | ----- +`From:` | visitor's email address +`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 + + +## Configuration file + +By default `sproxy2` will read its configuration from +`sproxy.yml`. There is example file with documentation +[sproxy.yml.example](sproxy.yml.example). You can specify a +custom path with: + +``` +sproxy --config /path/to/sproxy.yml +``` + diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/sproxy.sql b/sproxy.sql new file mode 100644 index 0000000..cda98f4 --- /dev/null +++ b/sproxy.sql @@ -0,0 +1,168 @@ +/* + +-- as super user: + +-- NOT idempotent +CREATE DATABASE sproxy; +CREATE ROLE sproxy; -- this is for management tools like sproxy-web +CREATE ROLE "sproxy-readonly"; -- this is for sproxy itself (sic!) + +-- idempotent from here on: +ALTER DATABASE sproxy OWNER TO sproxy; +ALTER ROLE "sproxy-readonly" LOGIN; +ALTER ROLE sproxy LOGIN; + +\c sproxy; + +SET ROLE sproxy; +-- as database owner (sproxy) from here on: + +GRANT SELECT ON ALL TABLES IN SCHEMA public TO "sproxy-readonly"; +ALTER DEFAULT PRIVILEGES IN SCHEMA public GRANT SELECT ON TABLES TO "sproxy-readonly"; + +*/ + + +BEGIN; + +CREATE TABLE IF NOT EXISTS "group" ( + "group" TEXT NOT NULL PRIMARY KEY, + "comment" TEXT +); + +-- | group | +-- |--------------| +-- | data science | +-- | devops | +-- | all | +-- | regional | + + +CREATE TABLE IF NOT EXISTS group_member ( + "group" TEXT REFERENCES "group" ("group") ON UPDATE CASCADE ON DELETE CASCADE NOT NULL, + email TEXT NOT NULL, + "comment" TEXT, + PRIMARY KEY ("group", email) +); + +-- | group | email | +-- |--------------+------------------------| +-- | data science | blah@example.com | +-- | data science | foo@example.com | +-- | devops | devops1@example.com | +-- | devops | devops2@example.com | +-- | all | %@example.com | + +-- Find out which groups a user (email address) belongs to: +-- SELECT "group" FROM group_member WHERE 'email.address' LIKE email + +CREATE TABLE IF NOT EXISTS domain ( + domain TEXT NOT NULL PRIMARY KEY, + "comment" TEXT +); + +-- | domain | +-- |-----------------------| +-- | app1.example.com | +-- | app2.example.com | +-- | app3.example.com | + +CREATE TABLE IF NOT EXISTS privilege ( + "domain" TEXT REFERENCES domain (domain) ON UPDATE CASCADE ON DELETE CASCADE NOT NULL, + privilege TEXT NOT NULL, + "comment" TEXT, + PRIMARY KEY ("domain", privilege) +); + +-- | domain | privilege | +-- |-----------------------+------------| +-- | app3.example.com | view | +-- | app3.example.com | export | +-- | app1.example.com | list users | +-- | app1.example.com | add users | + +CREATE TABLE IF NOT EXISTS privilege_rule ( + "domain" TEXT NOT NULL, + privilege TEXT NOT NULL, + "path" TEXT NOT NULL, + "method" TEXT NOT NULL, + "comment" TEXT, + FOREIGN KEY ("domain", privilege) REFERENCES privilege ("domain", privilege) ON UPDATE CASCADE ON DELETE CASCADE, + PRIMARY KEY ("domain", "path", "method") +); + +-- | domain | privilege | path | method | +-- |-----------------------+------------+-----------+--------| +-- | app3.example.com | view | /% | % | +-- | app3.example.com | export | /export/% | % | +-- | app1.example.com | list users | /users | GET | +-- | app1.example.com | list users | /user/% | GET | +-- | app1.example.com | add users | /users | POST | + +CREATE TABLE IF NOT EXISTS group_privilege ( + "group" TEXT REFERENCES "group" ("group") ON UPDATE CASCADE ON DELETE CASCADE NOT NULL, + "domain" TEXT NOT NULL, + privilege TEXT NOT NULL, + "comment" TEXT, + FOREIGN KEY ("domain", privilege) REFERENCES privilege ("domain", privilege) ON UPDATE CASCADE ON DELETE CASCADE, + PRIMARY KEY ("group", "domain", privilege) +); + +-- | group | domain | privilege | +-- |--------------+-----------------------+------------| +-- | data science | app3.example.com | view | +-- | data science | app3.example.com | export | +-- | all | app1.example.com | list users | +-- | devops | app1.example.com | add users | + +-- Check if the user is authorized for the request. Let's break it +-- down for understanding: + +-- The privilege required to access a URL is the most specific +-- (longest) match. To determine length, we look at the number of +-- slashes in the URL pattern (number of path components). +-- +-- SELECT p.privilege FROM privilege p +-- INNER JOIN privilege_rule pr ON pr."domain" = p."domain" AND pr.privilege = p.privilege +-- WHERE 'app3.example.com' LIKE pr."domain" AND '/export/test' LIKE "path" AND 'GET' ILIKE "method" +-- ORDER by array_length(regexp_split_to_array("path", '/'), 1) DESC LIMIT 1 +-- +-- To get the groups that grant the user access, put that in a subquery: +-- +-- SELECT gp."group" FROM group_privilege gp +-- INNER JOIN group_member gm ON gm."group" = gp."group" +-- WHERE 'blah@example.com' LIKE email +-- AND 'app3.example.com' LIKE "domain" +-- AND privilege IN ( +-- SELECT p.privilege FROM privilege p +-- INNER JOIN privilege_rule pr ON pr."domain" = p."domain" AND pr.privilege = p.privilege +-- WHERE 'app3.example.com' LIKE pr."domain" AND '/export/test' LIKE "path" AND 'GET' ILIKE "method" +-- ORDER by array_length(regexp_split_to_array("path", '/'), 1) DESC LIMIT 1 +-- ) +-- +-- If you just want to know if a user has access or not, you can +-- change the first line to: +-- +-- SELECT COUNT(*) > 0 FROM group_privilege gp +-- +-- Note for the future: If you want to support wildcards that match +-- only a single path component (e.g. app1.example.com/user/:/email), +-- you could try something like: +-- +-- WHERE 'url' ~ regexp_replace(url, ':', '[^/]+') +-- +-- But you'd also have to escape any regexp special characters in the +-- url as well (i.e. dots). + +-- Example data for development: +/* + INSERT INTO domain (domain) VALUES ('example.com'); + INSERT INTO "group" ("group") VALUES ('dev'); + INSERT INTO group_member ("group", email) VALUES ('dev', '%'); + INSERT INTO privilege (domain, privilege) VALUES ('example.com', 'full'); + INSERT INTO group_privilege ("group", domain, privilege) VALUES ('dev', 'example.com', 'full'); + INSERT INTO privilege_rule (domain, privilege, path, method) VALUES ('example.com', 'full', '%', '%'); +*/ + +END; + diff --git a/sproxy.yml.example b/sproxy.yml.example new file mode 100644 index 0000000..d539956 --- /dev/null +++ b/sproxy.yml.example @@ -0,0 +1,139 @@ +--- # Sproxy configuration. Don't remove this line. This is YAML: https://en.wikipedia.org/wiki/YAML + +# The port Sproxy listens on (HTTPS). +# Optional. Default is 443. +# +# listen: 443 + +# Listen on port 80 and redirect HTTP requests to HTTPS. +# Optional. Default is true when listen == 443, otherwise false. +# +# listen80: true + +# Whether HTTP2 is enabled. Optional. Default is "true" +# +# http2: true + +# The system user Sproxy switches to if launched as root (after opening the ports). +# Optional. Default is sproxy. +# +# user: sproxy + +# Home directory for various files including SQLite3 authorization database. +# Optional. Default is current directory. +# +# home: "." + +# PostgreSQL database connection string. +# Optional. If specified, sproxy will periodically pull the data from this +# database into internal SQLite3 database. Define password in a file +# referenced by the PGPASSFILE environment variable. Or use the "pgpassfile" option. +# Example: +# database: "user=sproxy-readonly dbname=sproxy port=6001" +# +# database: + +# PostgreSQL password file. +# Optional. If specified, sproxy will set PGPASSFILE environment variable pointing to this file +# Example: +# pgpassfile: /run/keys/sproxy.pgpass +# +# pgpassfile: + +# Logging level: debug, info, warn, error. +# Optional. Default is debug. +# +# log_level: debug + +# A file with arbitrary content used to sign sproxy cookie and other things (secret!). +# Optional. If not specified, a random key is generated on startup, and +# as a consequence, restaring sproxy will invalidate existing user sessions. +# This option could be useful for load-balancing with multiple sproxy instances, +# when all instances must understand cookies created by each other. +# This should not be very large, a few random bytes are fine. +# +# key: /run/keys/sproxy.secret + +# File with SSL certificate. Required. +# It can be a bundle with the server certificate coming first: +# cat me-cert.pem CA-cert.pem > cert.pem +# Once again: most wanted certs go first ;-) +# Or you can opt in using of `ssl_cert_chain` +ssl_cert: /path/cert.pem + +# File with SSL key (secret!). Required. +ssl_key: /path/key.pem + +# Chain SSL certificate files. +# Optional. Default is an empty list +# Example: +# ssl_cert_chain: +# - /path/foo.pem +# - /path/bar.pem +# +# ssl_cert_chain: [] + + +# Credentials for supported OAuth2 providers. +# Currently supported: "google", "linkedin" +# At least one provider is required. +# Attributes: +# client_id - OAuth2 client ID (string) +# client_secret - OAuth2 client secret. Regardless of its name, this is a file. +# The secret is read from the file which you should keep secret. +# Only the first line of this file is read. +# +# Example: +# oauth2: +# google: +# client_id: "XXXXXXXXXXXX-YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY.apps.googleusercontent.com" +# client_secret: "/run/keys/XXXXXXXXXXXX-YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY.apps.googleusercontent.com" +# +# linkedin: +# client_id: "xxxxxxxxxxxxxx" +# client_secret: "/run/keys/xxxxxxxxxxxxxx" +# +# +# oauth2: +# google: +# client_id: +# client_secret: + + +# Backend servers. At least one is required. +# NOTE: backends at TCP port are not secure, even on localhost, +# because any local user can connect to the backend bypassing sproxy +# authentication and authorization. +# +# It is recommended to communicate with backends via unix sockets only. +# Unix sockets should be secured with proper unix file permissions. +# +# Backend attributes: +# name - the host name as in the Host HTTP header. +# May include wildcards * and ?. The first matching +# backend will be used. Examples: "*.example.com", "wiki.corp.com". +# Optional. Default is "*". Note, that the name must include +# port number if non-standard. +# address - backend IP address. Optional. Default is 127.0.0.1. +# port - backend TCP port. Required unless unix socket is defined. +# socket - unix socket. Highly recommended for security reasons. +# If defined, IP address and TCP port are ignored. +# +# cookie_name - sproxy cookie name. Optional. Default is "sproxy". +# cookie_domain - sproxy cookie domain. Optional. Default is the request host name as per RFC2109. +# cookie_max_age - sproxy cookie shelflife in seconds. Optional. Default is 604800 (7 days). +# conn_count - number of connections to keep alive. Optional. Default is 32. +# This is specific to Haskell HTTP Client library, and is per host name, +# not per backend. HTTP Client's default is 10. +# +# backends: +# - name: wiki.example.com +# port: 9090 +# cookie_name: sproxy_example +# cookie_max_age: 86400 +# +backends: + - port: 8080 + +... # End of configuration. Don't remove this line. This is YAML: https://en.wikipedia.org/wiki/YAML + diff --git a/sproxy2.cabal b/sproxy2.cabal new file mode 100644 index 0000000..f0817c0 --- /dev/null +++ b/sproxy2.cabal @@ -0,0 +1,72 @@ +name: sproxy2 +version: 1.90.0 +synopsis: Secure HTTP proxy for authenticating users via OAuth2 +description: + Sproxy is secure by default. No requests makes it to the backend + server if they haven't been explicitly whitelisted. Sproxy is + independent. Any web application written in any language can + use it. +license: MIT +license-file: LICENSE +author: Igor Pashev <pashev.igor@gmail.com> +maintainer: Igor Pashev <pashev.igor@gmail.com> +copyright: 2016, Zalora South East Asia Pte. Ltd +category: Databases, Web +build-type: Simple +extra-source-files: README.md ChangeLog.md sproxy.yml.example sproxy.sql +cabal-version: >= 1.20 + +source-repository head + type: git + location: https://github.com/ip1981/sproxy2.git + +executable sproxy2 + default-language: Haskell2010 + ghc-options: -Wall -static -threaded + hs-source-dirs: src + main-is: Main.hs + other-modules: + Sproxy.Application + Sproxy.Application.Cookie + Sproxy.Application.OAuth2 + Sproxy.Application.OAuth2.Common + Sproxy.Application.OAuth2.Google + Sproxy.Application.OAuth2.LinkedIn + Sproxy.Application.State + Sproxy.Config + Sproxy.Logging + Sproxy.Server + Sproxy.Server.DB + build-depends: + base >= 4.8 && < 50 + , aeson + , base64-bytestring + , blaze-builder + , bytestring + , cereal + , conduit + , containers + , cookie >= 0.4.2 + , docopt + , entropy + , Glob + , http-client >= 0.5.3 + , http-conduit + , http-types + , interpolatedstring-perl6 + , network + , postgresql-simple + , resource-pool + , SHA + , sqlite-simple + , text + , time + , unix + , unordered-containers + , wai + , wai-conduit + , warp + , warp-tls >= 3.2 + , word8 + , yaml >= 0.8.4 + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..7101af0 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE QuasiQuotes #-} +module Main ( + main +) where + +import Data.Maybe (fromJust) +import Data.Version (showVersion) +import Paths_sproxy2 (version) -- from cabal +import System.Environment (getArgs) +import Text.InterpolatedString.Perl6 (qc) +import qualified System.Console.Docopt.NoTH as O + +import Sproxy.Server (server) + +usage :: String +usage = "sproxy2 " ++ showVersion version ++ + " - HTTP proxy for authenticating users via OAuth2" ++ [qc| + +Usage: + sproxy2 [options] + +Options: + -c, --config=FILE Configuration file [default: sproxy.yml] + -h, --help Show this message + +|] + +main :: IO () +main = do + doco <- O.parseUsageOrExit usage + args <- O.parseArgsOrExit doco =<< getArgs + if args `O.isPresent` O.longOption "help" + then putStrLn $ O.usage doco + else do + let configFile = fromJust . O.getArg args $ O.longOption "config" + server configFile + diff --git a/src/Sproxy/Application.hs b/src/Sproxy/Application.hs new file mode 100644 index 0000000..2391220 --- /dev/null +++ b/src/Sproxy/Application.hs @@ -0,0 +1,372 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Sproxy.Application ( + sproxy +, redirect +) where + +import Blaze.ByteString.Builder (toByteString) +import Blaze.ByteString.Builder.ByteString (fromByteString) +import Control.Exception (SomeException, catch) +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) +import Data.HashMap.Strict as HM (HashMap, foldrWithKey, lookup) +import Data.List (find, partition) +import Data.Map as Map (delete, fromListWith, insert, insertWith, toList) +import Data.Maybe (fromJust, fromMaybe) +import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Data.Word (Word16) +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, hConnection, + hContentLength, hContentType, hCookie, hLocation, methodGet) +import Network.HTTP.Types.Status ( Status(..), badRequest400, forbidden403, found302, + internalServerError500, methodNotAllowed405, movedPermanently301, + networkAuthenticationRequired511, notFound404, ok200, seeOther303, temporaryRedirect307 ) +import Network.Socket (NameInfoFlag(NI_NUMERICHOST), getNameInfo) +import Network.Wai.Conduit (sourceRequestBody, responseSource) +import System.FilePath.Glob (Pattern, match) +import System.Posix.Time (epochTime) +import Text.InterpolatedString.Perl6 (qc) +import Web.Cookie (Cookies, parseCookies, renderCookies) +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.OAuth2.Common (OAuth2Client(..)) +import Sproxy.Config(BackendConf(..)) +import Sproxy.Server.DB (Database, userExists, userGroups) +import qualified Sproxy.Application.State as State +import qualified Sproxy.Logging as Log + + +redirect :: Word16 -> W.Application +redirect p req resp = + case W.requestHeaderHost req of + Nothing -> badRequest "missing host" req resp + Just host -> do + Log.info $ "redirecting to " ++ show location ++ ": " ++ showReq req + resp $ W.responseBuilder status [(hLocation, location)] mempty + where + status = if W.requestMethod req == methodGet then movedPermanently301 else temporaryRedirect307 + (domain, _) = BS.break (== _colon) host + newhost = if p == 443 then domain else domain <> ":" <> pack (show p) + location = "https://" <> newhost <> W.rawPathInfo req <> W.rawQueryString req + + +sproxy :: ByteString -> Database -> HashMap Text OAuth2Client -> [(Pattern, BackendConf, BE.Manager)] -> W.Application +sproxy key db oa2 backends = logException $ \req resp -> do + Log.debug $ "sproxy <<< " ++ showReq req + case W.requestHeaderHost req of + Nothing -> badRequest "missing host" req resp + Just host -> + case find (\(p, _, _) -> match p (unpack host)) backends of + Nothing -> notFound "backend" req resp + Just (_, be, mgr) -> do + let cookieName = pack $ beCookieName be + cookieDomain = pack <$> beCookieDomain be + case W.pathInfo req of + ["robots.txt"] -> get robots req resp + (".sproxy":proxy) -> + case proxy of + ["logout"] -> + case extractCookie key Nothing cookieName req of + Nothing -> notFound "logout without the cookie" req resp + Just _ -> get (logout 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 + _ -> notFound "proxy" req resp + _ -> do + now <- Just <$> epochTime + case extractCookie key now cookieName req of + Nothing -> authenticationRequired key oa2 req resp + Just cs@(authCookie, _) -> + authorize db cs req >>= \case + Nothing -> forbidden authCookie req resp + Just req' -> forward mgr req' resp + + +robots :: W.Application +robots _ resp = resp $ + W.responseLBS ok200 [(hContentType, "text/plain; charset=utf-8")] + "User-agent: *\nDisallow: /" + + +oauth2callback :: ByteString -> Database -> (Text, OAuth2Client) -> BackendConf -> W.Application +oauth2callback key db (provider, oa2c) be req resp = + case param "code" of + Nothing -> badRequest "missing auth code" req resp + Just code -> + case param "state" of + Nothing -> badRequest "missing auth state" req resp + Just state -> + case State.decode key state of + 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 + exists <- userExists db email + if exists then authenticate key be au{auEmail = email} path req resp + else userNotFound email req resp + where + param p = do + (_, v) <- find ((==) p . fst) $ W.queryString req + v + + +-- XXX: RFC6265: the user agent MUST NOT attach more than one Cookie header field +extractCookie :: ByteString -> Maybe CTime -> ByteString -> W.Request -> Maybe (AuthCookie, Cookies) +extractCookie key now name req = do + (_, cookies) <- find ((==) hCookie . fst) $ W.requestHeaders req + (auth, others) <- discriminate cookies + case cookieDecode key auth of + Left _ -> Nothing + Right cookie -> if maybe True (acExpiry cookie >) now + then Just (cookie, others) else Nothing + where discriminate cs = + case partition ((==) name . fst) $ parseCookies cs of + ((_, x):_, xs) -> Just (x, xs) + _ -> Nothing + + +authenticate :: ByteString -> BackendConf -> AuthUser -> ByteString -> W.Application +authenticate key be user path req resp = do + now <- epochTime + let host = fromJust $ W.requestHeaderHost req + domain = pack <$> beCookieDomain be + expiry = now + CTime (beCookieMaxAge be) + authCookie = AuthCookie { acUser = user, acExpiry = expiry } + cookie = WC.def { + WC.setCookieName = pack $ beCookieName be + , WC.setCookieHttpOnly = True + , WC.setCookiePath = Just "/" + , WC.setCookieSameSite = Nothing + , WC.setCookieSecure = True + , WC.setCookieValue = cookieEncode key authCookie + , WC.setCookieDomain = domain + , WC.setCookieExpires = Just . posixSecondsToUTCTime . realToFrac $ expiry + } + resp $ W.responseLBS seeOther303 [ + (hLocation, "https://" <> host <> path) + , ("Set-Cookie", toByteString $ WC.renderSetCookie cookie) + ] "" + + +authorize :: Database -> (AuthCookie, Cookies) -> W.Request -> IO (Maybe W.Request) +authorize db (authCookie, otherCookies) req = do + 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 "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) + + +forward :: BE.Manager -> W.Application +forward mgr req resp = do + let beReq = BE.defaultRequest + { BE.method = W.requestMethod req + , BE.path = W.rawPathInfo req + , BE.queryString = W.rawQueryString req + , BE.requestHeaders = modifyRequestHeaders $ W.requestHeaders req + , BE.redirectCount = 0 + , BE.decompress = const False + , BE.requestBody = case W.requestBodyLength req of + W.ChunkedBody -> requestBodySourceChunkedIO (sourceRequestBody req) + W.KnownLength l -> requestBodySourceIO (fromIntegral l) (sourceRequestBody req) + } + msg = unpack (BE.method beReq <> " " <> BE.path beReq <> BE.queryString beReq) + Log.debug $ "BACKEND <<< " ++ msg ++ " " ++ show (BE.requestHeaders beReq) + BE.withResponse beReq mgr $ \res -> do + let status = BE.responseStatus res + headers = modifyResponseHeaders $ BE.responseHeaders res + body = mapOutput (Chunk . fromByteString) . bodyReaderSource $ BE.responseBody res + logging = if statusCode status `elem` [ 400, 500 ] then + Log.warn else Log.debug + logging $ "BACKEND >>> " ++ show (statusCode status) ++ " on " ++ msg ++ "\n" + resp $ responseSource status headers body + + +modifyRequestHeaders :: RequestHeaders -> RequestHeaders +modifyRequestHeaders = filter (\(n, _) -> n `notElem` ban) + where + ban = + [ + hConnection + , hContentLength -- XXX to avoid duplicate header + ] + +modifyResponseHeaders :: ResponseHeaders -> ResponseHeaders +modifyResponseHeaders = filter (\(n, _) -> n `notElem` ban) + where + ban = + [ + hConnection + ] + +authenticationRequired :: ByteString -> HashMap Text OAuth2Client -> W.Application +authenticationRequired key oa2 req resp = do + Log.info $ "511 Unauthenticated: " ++ showReq req + resp $ W.responseLBS networkAuthenticationRequired511 [(hContentType, "text/html; charset=utf-8")] page + where + path = W.rawPathInfo req -- FIXME: make it more robust for non-GET or XMLHTTPRequest? + state = State.encode key path + authLink :: Text -> OAuth2Client -> ByteString -> ByteString + authLink provider oa2c html = + let u = oauth2AuthorizeURL oa2c state (redirectURL req provider) + d = pack $ oauth2Description oa2c + in [qc|{html}<p><a href="{u}">Authenticate with {d}</a></p>|] + authHtml = foldrWithKey authLink "" oa2 + page = fromStrict [qc| +<!DOCTYPE html> +<html lang="en"> + <head> + <meta charset="utf-8"> + <title>Authentication required</title> + </head> + <body style="text-align:center;"> + <h1>Authentication required</h1> + {authHtml} + </body> +</html> +|] + + +forbidden :: AuthCookie -> W.Application +forbidden ac req resp = do + Log.info $ "403 Forbidden (" ++ email ++ "): " ++ showReq req + resp $ W.responseLBS forbidden403 [(hContentType, "text/html; charset=utf-8")] page + where + email = auEmail . acUser $ ac + page = fromStrict [qc| +<!DOCTYPE html> +<html lang="en"> + <head> + <meta charset="utf-8"> + <title>Access Denied</title> + </head> + <body> + <h1>Access Denied</h1> + <p>You are currently logged in as <strong>{email}</strong></p> + <p><a href="/.sproxy/logout">Logout</a></p> + </body> +</html> +|] + + +userNotFound :: String -> W.Application +userNotFound email _ resp = do + Log.info $ "404 User not found (" ++ email ++ ")" + resp $ W.responseLBS notFound404 [(hContentType, "text/html; charset=utf-8")] page + where + page = fromStrict [qc| +<!DOCTYPE html> +<html lang="en"> + <head> + <meta charset="utf-8"> + <title>Access Denied</title> + </head> + <body> + <h1>Access Denied</h1> + <p>You are not allowed to login as <strong>{email}</strong></p> + <p><a href="/">Main page</a></p> + </body> +</html> +|] + + +logout :: ByteString -> Maybe ByteString -> W.Application +logout name domain req resp = do + let host = fromJust $ W.requestHeaderHost req + cookie = WC.def { + WC.setCookieName = name + , WC.setCookieHttpOnly = True + , WC.setCookiePath = Just "/" + , WC.setCookieSameSite = Just WC.sameSiteStrict + , WC.setCookieSecure = True + , WC.setCookieValue = "goodbye" + , WC.setCookieDomain = domain + , WC.setCookieExpires = Just . posixSecondsToUTCTime . realToFrac $ CTime 0 + } + resp $ W.responseLBS found302 [ + (hLocation, "https://" <> host) + , ("Set-Cookie", toByteString $ WC.renderSetCookie cookie) + ] "" + + +badRequest ::String -> W.Application +badRequest msg req resp = do + Log.warn $ "400 Bad Request (" ++ msg ++ "): " ++ showReq req + resp $ W.responseLBS badRequest400 [] "Bad Request" + + +notFound ::String -> W.Application +notFound msg req resp = do + Log.warn $ "404 Not Found (" ++ msg ++ "): " ++ showReq req + resp $ W.responseLBS notFound404 [] "Not Found" + + +logException :: W.Middleware +logException app req resp = catch (app req resp) $ \e -> do + Log.error $ "500 Internal Error: " ++ show (e :: SomeException) ++ " on " ++ showReq req + resp $ W.responseLBS internalServerError500 [] "Internal Error" + + +get :: W.Middleware +get app req resp + | W.requestMethod req == methodGet = app req resp + | otherwise = do + Log.warn $ "405 Method Not Allowed: " ++ showReq req + resp $ W.responseLBS methodNotAllowed405 [("Allow", "GET")] "Method Not Allowed" + + +redirectURL :: W.Request -> Text -> ByteString +redirectURL req provider = + "https://" <> fromJust (W.requestHeaderHost req) + <> "/.sproxy/oauth2/" <> encodeUtf8 provider + + +-- XXX: make sure not to reveal the cookie, which can be valid (!) +showReq :: W.Request -> String +showReq req = + unpack ( W.requestMethod req <> " " + <> fromMaybe "<no host>" (W.requestHeaderHost req) + <> W.rawPathInfo req <> W.rawQueryString req <> " " ) + ++ show (fromMaybe "-" $ W.requestHeaderReferer req) ++ " " + ++ show (fromMaybe "-" $ W.requestHeaderUserAgent req) + ++ " from " ++ show (W.remoteHost req) + diff --git a/src/Sproxy/Application/Cookie.hs b/src/Sproxy/Application/Cookie.hs new file mode 100644 index 0000000..07cc162 --- /dev/null +++ b/src/Sproxy/Application/Cookie.hs @@ -0,0 +1,44 @@ +module Sproxy.Application.Cookie ( + AuthCookie(..) +, AuthUser(..) +, cookieDecode +, cookieEncode +) where + +import Data.ByteString (ByteString) +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 +} + +data AuthCookie = AuthCookie { + acUser :: AuthUser +, acExpiry :: CTime +} + +instance DS.Serialize AuthCookie where + put c = DS.put (auEmail u, auGivenName u, auFamilyName u, x) + where u = acUser c + x = (\(CTime i) -> i) $ acExpiry c + get = do + (e, n, f, x) <- DS.get + return AuthCookie { + acUser = AuthUser { auEmail = e, auGivenName = n, auFamilyName = f } + , acExpiry = CTime x + } + + +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 + + diff --git a/src/Sproxy/Application/OAuth2.hs b/src/Sproxy/Application/OAuth2.hs new file mode 100644 index 0000000..0f7d6e8 --- /dev/null +++ b/src/Sproxy/Application/OAuth2.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} +module Sproxy.Application.OAuth2 ( + providers +) where + +import Data.HashMap.Strict (HashMap, fromList) +import Data.Text (Text) + +import Sproxy.Application.OAuth2.Common (OAuth2Provider) +import qualified Sproxy.Application.OAuth2.Google as Google +import qualified Sproxy.Application.OAuth2.LinkedIn as LinkedIn + +providers :: HashMap Text OAuth2Provider +providers = fromList [ + ("google" , Google.provider) + , ("linkedin" , LinkedIn.provider) + ] + diff --git a/src/Sproxy/Application/OAuth2/Common.hs b/src/Sproxy/Application/OAuth2/Common.hs new file mode 100644 index 0000000..07fb759 --- /dev/null +++ b/src/Sproxy/Application/OAuth2/Common.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} +module Sproxy.Application.OAuth2.Common ( + AccessTokenBody(..) +, OAuth2Client(..) +, OAuth2Provider +) where + +import Control.Applicative (empty) +import Data.Aeson (FromJSON, parseJSON, Value(Object), (.:)) +import Data.ByteString(ByteString) + +import Sproxy.Application.Cookie (AuthUser) + +data OAuth2Client = OAuth2Client { + oauth2Description :: String +, oauth2AuthorizeURL + :: ByteString -- state + -> ByteString -- redirect url + -> ByteString +, oauth2Authenticate + :: ByteString -- code + -> ByteString -- redirect url + -> IO AuthUser +} + +type OAuth2Provider = (ByteString, ByteString) -> OAuth2Client + +-- | RFC6749. We ignore optional token_type ("Bearer" from Google, omitted by LinkedIn) +-- 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 +} deriving (Eq, Show) + +instance FromJSON AccessTokenBody where + parseJSON (Object v) = AccessTokenBody + <$> v .: "access_token" + parseJSON _ = empty + diff --git a/src/Sproxy/Application/OAuth2/Google.hs b/src/Sproxy/Application/OAuth2/Google.hs new file mode 100644 index 0000000..6b68f44 --- /dev/null +++ b/src/Sproxy/Application/OAuth2/Google.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +module Sproxy.Application.OAuth2.Google ( + provider +) where + +import Control.Applicative (empty) +import Control.Exception (Exception, throwIO) +import Data.Aeson (FromJSON, decode, parseJSON, Value(Object), (.:)) +import Data.ByteString.Lazy (ByteString) +import Data.Monoid ((<>)) +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.OAuth2.Common (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider) + + +provider :: OAuth2Provider +provider (client_id, client_secret) = + OAuth2Client { + oauth2Description = "Google" + , oauth2AuthorizeURL = \state redirect_uri -> + "https://accounts.google.com/o/oauth2/v2/auth" + <> "?scope=" <> urlEncode True "https://www.googleapis.com/auth/userinfo.email https://www.googleapis.com/auth/userinfo.profile" + <> "&client_id=" <> urlEncode True client_id + <> "&prompt=select_account" + <> "&redirect_uri=" <> urlEncode True redirect_uri + <> "&response_type=code" + <> "&state=" <> urlEncode True state + + , oauth2Authenticate = \code redirect_uri -> do + let treq = H.setQueryString [ + ("client_id" , Just client_id) + , ("client_secret" , Just client_secret) + , ("code" , Just code) + , ("grant_type" , Just "authorization_code") + , ("redirect_uri" , Just redirect_uri) + ] $ (H.parseRequest_ "POST https://www.googleapis.com/oauth2/v4/token") { + H.requestHeaders = [ + (hContentType, "application/x-www-form-urlencoded") + ] + } + mgr <- H.newManager H.tlsManagerSettings + tresp <- H.httpLbs treq mgr + 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 + 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 } + } + + +data GoogleException = GoogleException (H.Response ByteString) + deriving (Show, Typeable) + + +instance Exception GoogleException + + +data GoogleUserInfo = GoogleUserInfo { + email :: String +, givenName :: String +, familyName :: String +} deriving (Eq, Show) + +instance FromJSON GoogleUserInfo where + parseJSON (Object v) = GoogleUserInfo + <$> v .: "email" + <*> v .: "given_name" + <*> v .: "family_name" + parseJSON _ = empty + diff --git a/src/Sproxy/Application/OAuth2/LinkedIn.hs b/src/Sproxy/Application/OAuth2/LinkedIn.hs new file mode 100644 index 0000000..b60afde --- /dev/null +++ b/src/Sproxy/Application/OAuth2/LinkedIn.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +module Sproxy.Application.OAuth2.LinkedIn ( + provider +) where + +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.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.OAuth2.Common (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider) + + +provider :: OAuth2Provider +provider (client_id, client_secret) = + OAuth2Client { + oauth2Description = "LinkedIn" + , oauth2AuthorizeURL = \state redirect_uri -> + "https://www.linkedin.com/oauth/v2/authorization" + <> "?scope=r_basicprofile%20r_emailaddress" + <> "&client_id=" <> urlEncode True client_id + <> "&redirect_uri=" <> urlEncode True redirect_uri + <> "&response_type=code" + <> "&state=" <> urlEncode True state + + , oauth2Authenticate = \code redirect_uri -> do + let treq = H.setQueryString [ + ("client_id" , Just client_id) + , ("client_secret" , Just client_secret) + , ("code" , Just code) + , ("grant_type" , Just "authorization_code") + , ("redirect_uri" , Just redirect_uri) + ] $ (H.parseRequest_ "POST https://www.linkedin.com/oauth/v2/accessToken") { + H.requestHeaders = [ + (hContentType, "application/x-www-form-urlencoded") + ] + } + mgr <- H.newManager H.tlsManagerSettings + tresp <- H.httpLbs treq mgr + case decode $ H.responseBody tresp of + Nothing -> throwIO $ LinkedInException tresp + 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)) ] + } + 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 } + } + + +data LinkedInException = LinkedInException (H.Response ByteString) + deriving (Show, Typeable) + + +instance Exception LinkedInException + + +data LinkedInUserInfo = LinkedInUserInfo { + emailAddress :: String +, firstName :: String +, lastName :: String +} deriving (Eq, Show) + +instance FromJSON LinkedInUserInfo where + parseJSON (Object v) = LinkedInUserInfo + <$> v .: "emailAddress" + <*> v .: "firstName" + <*> v .: "lastName" + parseJSON _ = empty + diff --git a/src/Sproxy/Application/State.hs b/src/Sproxy/Application/State.hs new file mode 100644 index 0000000..29d9252 --- /dev/null +++ b/src/Sproxy/Application/State.hs @@ -0,0 +1,30 @@ +module Sproxy.Application.State ( + decode +, encode +) where + +import Data.ByteString (ByteString) +import Data.ByteString.Lazy (fromStrict, toStrict) +import Data.Digest.Pure.SHA (hmacSha1, bytestringDigest) +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.Serialize as DS + + +-- FIXME: Compress / decompress ? + + +encode :: ByteString -> ByteString -> ByteString +encode key payload = Base64.encode . DS.encode $ (payload, digest key payload) + + +decode :: ByteString -> ByteString -> Either String ByteString +decode key d = do + (payload, dgst) <- DS.decode =<< Base64.decode d + if dgst /= digest key payload + then Left "junk" + else Right payload + + +digest :: ByteString -> ByteString -> ByteString +digest key payload = toStrict . bytestringDigest $ hmacSha1 (fromStrict key) (fromStrict payload) + diff --git a/src/Sproxy/Config.hs b/src/Sproxy/Config.hs new file mode 100644 index 0000000..30a8bae --- /dev/null +++ b/src/Sproxy/Config.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE OverloadedStrings #-} +module Sproxy.Config ( + BackendConf(..) +, ConfigFile(..) +, OAuth2Conf(..) +) where + +import Control.Applicative (empty) +import Data.Aeson (FromJSON, parseJSON) +import Data.HashMap.Strict (HashMap) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Word (Word16) +import Data.Yaml (Value(Object), (.:), (.:?), (.!=)) + +import Sproxy.Logging (LogLevel(Debug)) + +data ConfigFile = ConfigFile { + cfListen :: Word16 +, cfUser :: String +, cfHome :: FilePath +, cfLogLevel :: LogLevel +, cfSslCert :: FilePath +, cfSslKey :: FilePath +, cfSslCertChain :: [FilePath] +, cfKey :: Maybe FilePath +, cfListen80 :: Maybe Bool +, cfBackends :: [BackendConf] +, cfOAuth2 :: HashMap Text OAuth2Conf +, cfDatabase :: Maybe String +, cfPgPassFile :: Maybe FilePath +, cfHTTP2 :: Bool +} deriving (Show) + +instance FromJSON ConfigFile where + parseJSON (Object m) = ConfigFile <$> + m .:? "listen" .!= 443 + <*> m .:? "user" .!= "sproxy" + <*> m .:? "home" .!= "." + <*> m .:? "log_level" .!= Debug + <*> m .: "ssl_cert" + <*> m .: "ssl_key" + <*> m .:? "ssl_cert_chain" .!= [] + <*> m .:? "key" + <*> m .:? "listen80" + <*> m .: "backends" + <*> m .: "oauth2" + <*> m .:? "database" + <*> m .:? "pgpassfile" + <*> m .:? "http2" .!= True + parseJSON _ = empty + + +data BackendConf = BackendConf { + beName :: String +, beAddress :: String +, bePort :: Maybe Word16 +, beSocket :: Maybe FilePath +, beCookieName :: String +, beCookieDomain :: Maybe String +, beCookieMaxAge :: Int64 +, beConnCount :: Int +} deriving (Show) + +instance FromJSON BackendConf where + parseJSON (Object m) = BackendConf <$> + m .:? "name" .!= "*" + <*> m .:? "address" .!= "127.0.0.1" + <*> m .:? "port" + <*> m .:? "socket" + <*> m .:? "cookie_name" .!= "sproxy" + <*> m .:? "cookie_domain" + <*> m .:? "cookie_max_age" .!= (7 * 24 * 60 * 60) + <*> m .:? "conn_count" .!= 32 + parseJSON _ = empty + + +data OAuth2Conf = OAuth2Conf { + oa2ClientId :: String +, oa2ClientSecret :: FilePath +} deriving (Show) + +instance FromJSON OAuth2Conf where + parseJSON (Object m) = OAuth2Conf <$> + m .: "client_id" + <*> m .: "client_secret" + parseJSON _ = empty + diff --git a/src/Sproxy/Logging.hs b/src/Sproxy/Logging.hs new file mode 100644 index 0000000..651a73a --- /dev/null +++ b/src/Sproxy/Logging.hs @@ -0,0 +1,99 @@ +module Sproxy.Logging ( + LogLevel(..) +, debug +, error +, info +, level +, start +, warn +) where + +import Prelude hiding (error) + +import Control.Applicative (empty) +import Control.Concurrent (forkIO) +import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) +import Control.Monad (forever, when) +import Data.Aeson (FromJSON, ToJSON) +import Data.Char (toLower) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import System.IO (hPrint, stderr) +import System.IO.Unsafe (unsafePerformIO) +import Text.Read (readMaybe) +import qualified Data.Aeson as JSON +import qualified Data.Text as T + +start :: LogLevel -> IO () +start None = return () +start lvl = do + writeIORef logLevel lvl + ch <- readIORef chanRef + _ <- forkIO . forever $ readChan ch >>= hPrint stderr + return () + +info :: String -> IO () +info = send . Message Info + +warn:: String -> IO () +warn = send . Message Warning + +error:: String -> IO () +error = send . Message Error + +debug :: String -> IO () +debug = send . Message Debug + + +send :: Message -> IO () +send msg@(Message l _) = do + lvl <- level + when (l <= lvl) $ do + ch <- readIORef chanRef + writeChan ch msg + +{-# NOINLINE chanRef #-} +chanRef :: IORef (Chan Message) +chanRef = unsafePerformIO (newChan >>= newIORef) + +{-# NOINLINE logLevel #-} +logLevel :: IORef LogLevel +logLevel = unsafePerformIO (newIORef None) + +level :: IO LogLevel +level = readIORef logLevel + + +data LogLevel = None | Error | Warning | Info | Debug + deriving (Enum, Ord, Eq) + +instance Show LogLevel where + show None = "NONE" + show Error = "ERROR" + show Warning = "WARN" + show Info = "INFO" + show Debug = "DEBUG" + +instance Read LogLevel where + readsPrec _ s + | l == "none" = [ (None, "") ] + | l == "error" = [ (Error, "") ] + | l == "warn" = [ (Warning, "") ] + | l == "info" = [ (Info, "") ] + | l == "debug" = [ (Debug, "") ] + | otherwise = [ ] + where l = map toLower s + +instance ToJSON LogLevel where + toJSON = JSON.String . T.pack . show + +instance FromJSON LogLevel where + parseJSON (JSON.String s) = + maybe (fail $ "unknown log level: " ++ show s) return (readMaybe . T.unpack $ s) + parseJSON _ = empty + + +data Message = Message LogLevel String + +instance Show Message where + show (Message lvl str) = show lvl ++ ": " ++ str + diff --git a/src/Sproxy/Server.hs b/src/Sproxy/Server.hs new file mode 100644 index 0000000..bd2af17 --- /dev/null +++ b/src/Sproxy/Server.hs @@ -0,0 +1,190 @@ +module Sproxy.Server ( + server +) where + +import Control.Concurrent (forkIO) +import Control.Exception (bracketOnError) +import Control.Monad (void, when) +import Data.ByteString as BS (hGetLine, readFile) +import Data.ByteString.Char8 (pack) +import Data.HashMap.Strict as HM (fromList, lookup, toList) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Word (Word16) +import Data.Yaml (decodeFileEither) +import Network.HTTP.Client (Manager, ManagerSettings(..), defaultManagerSettings, newManager, socketConnection) +import Network.HTTP.Client.Internal (Connection) +import Network.Socket ( Family(AF_INET, AF_UNIX), SockAddr(SockAddrInet, SockAddrUnix), + SocketOption(ReuseAddr), SocketType(Stream), bind, close, connect, inet_addr, + listen, maxListenQueue, setSocketOption, socket ) +import Network.Wai.Handler.WarpTLS (tlsSettingsChain, runTLSSocket) +import Network.Wai.Handler.Warp (defaultSettings, setHTTP2Disabled, runSettingsSocket) +import System.Entropy (getEntropy) +import System.Environment (setEnv) +import System.Exit (exitFailure) +import System.FilePath.Glob (compile) +import System.IO (IOMode(ReadMode), hIsEOF, hPutStrLn, stderr, withFile) +import System.Posix.User ( GroupEntry(..), UserEntry(..), + getAllGroupEntries, getRealUserID, + getUserEntryForName, setGroupID, setGroups, setUserID ) + +import Sproxy.Application (sproxy, redirect) +import Sproxy.Application.OAuth2.Common (OAuth2Client) +import Sproxy.Config (BackendConf(..), ConfigFile(..), OAuth2Conf(..)) +import qualified Sproxy.Application.OAuth2 as OAuth2 +import qualified Sproxy.Logging as Log +import qualified Sproxy.Server.DB as DB + + +server :: FilePath -> IO () +server configFile = do + cf <- readConfigFile configFile + Log.start $ cfLogLevel cf + Log.debug $ show cf + + sock <- socket AF_INET Stream 0 + setSocketOption sock ReuseAddr 1 + bind sock $ SockAddrInet (fromIntegral $ cfListen cf) 0 + + maybe80 <- if fromMaybe (443 == cfListen cf) (cfListen80 cf) + then do + sock80 <- socket AF_INET Stream 0 + setSocketOption sock80 ReuseAddr 1 + bind sock80 $ SockAddrInet 80 0 + return (Just sock80) + else + return Nothing + + uid <- getRealUserID + when (0 == uid) $ do + let user = cfUser cf + Log.info $ "switching to user " ++ show user + u <- getUserEntryForName user + groupIDs <- map groupID . filter (elem user . groupMembers) + <$> getAllGroupEntries + setGroups groupIDs + setGroupID $ userGroupID u + setUserID $ userID u + + case cfPgPassFile cf of + Nothing -> return () + Just f -> do + Log.info $ "pgpassfile: " ++ show f + setEnv "PGPASSFILE" f + + db <- DB.start (cfHome cf) (newDataSource cf) + + key <- maybe + (Log.info "using new random key" >> getEntropy 32) + (\f -> Log.info ("reading key from " ++ f) >> BS.readFile f) + (cfKey cf) + + case maybe80 of + Nothing -> return () + Just sock80 -> do + Log.info "listening on port 80 (HTTP redirect)" + listen sock80 maxListenQueue + void . forkIO $ runSettingsSocket defaultSettings sock80 (redirect $ cfListen cf) + + oauth2clients <- HM.fromList <$> mapM newOAuth2Client (HM.toList (cfOAuth2 cf)) + + backends <- + mapM (\be -> do + m <- newBackendManager be + return (compile $ beName be, be, m) + ) $ cfBackends cf + + let + settings = + (if cfHTTP2 cf then id else setHTTP2Disabled) + defaultSettings + + -- XXX 2048 is from bindPortTCP from streaming-commons used internally by runTLS. + -- XXX Since we don't call runTLS, we listen socket here with the same options. + Log.info $ "listening on port " ++ show (cfListen cf) ++ " (HTTPS)" + listen sock (max 2048 maxListenQueue) + runTLSSocket + (tlsSettingsChain (cfSslCert cf) (cfSslCertChain cf) (cfSslKey cf)) + settings + sock + (sproxy key db oauth2clients backends) + + +newDataSource :: ConfigFile -> Maybe DB.DataSource +newDataSource cf = + case cfDatabase cf of + Just str -> Just $ DB.PostgreSQL str + Nothing -> Nothing + + +newOAuth2Client :: (Text, OAuth2Conf) -> IO (Text, OAuth2Client) +newOAuth2Client (name, cfg) = + case HM.lookup name OAuth2.providers of + Nothing -> do Log.error $ "OAuth2 provider " ++ show name ++ " is not supported" + exitFailure + Just provider -> do + Log.info $ "oauth2: adding " ++ show name + client_secret <- withFile secret_file ReadMode $ \h -> do + empty <- hIsEOF h + if empty then do + Log.error $ "oauth2: empty secret file for " + ++ show name ++ ": " ++ show secret_file + return $ pack "" + else BS.hGetLine h + return (name, provider (pack client_id, client_secret)) + where client_id = oa2ClientId cfg + secret_file = oa2ClientSecret cfg + + +newBackendManager :: BackendConf -> IO Manager +newBackendManager be = do + openConn <- + case (beSocket be, bePort be) of + (Just f, Nothing) -> do + Log.info $ "backend `" ++ beName be ++ "' on UNIX socket " ++ f + return $ openUnixSocketConnection f + + (Nothing, Just n) -> do + Log.info $ "backend `" ++ beName be ++ "' on " ++ beAddress be ++ ":" ++ show n + return $ openTCPConnection (beAddress be) n + + _ -> do + Log.error "either backend port number or UNIX socket path is required." + exitFailure + + newManager defaultManagerSettings { + managerRawConnection = return $ \_ _ _ -> openConn + , managerConnCount = beConnCount be + } + + +openUnixSocketConnection :: FilePath -> IO Connection +openUnixSocketConnection f = + bracketOnError + (socket AF_UNIX Stream 0) + close + (\s -> do + connect s (SockAddrUnix f) + socketConnection s 8192) + + +openTCPConnection :: String -> Word16 -> IO Connection +openTCPConnection addr port = + bracketOnError + (socket AF_INET Stream 0) + close + (\s -> do + a <- inet_addr addr + connect s (SockAddrInet (fromIntegral port) a) + socketConnection s 8192) + + +readConfigFile :: FilePath -> IO ConfigFile +readConfigFile f = do + r <- decodeFileEither f + case r of + Left e -> do + hPutStrLn stderr $ "FATAL: " ++ f ++ ": " ++ show e + exitFailure + Right cf -> return cf + diff --git a/src/Sproxy/Server/DB.hs b/src/Sproxy/Server/DB.hs new file mode 100644 index 0000000..b760afc --- /dev/null +++ b/src/Sproxy/Server/DB.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Sproxy.Server.DB ( + Database +, DataSource(..) +, userExists +, userGroups +, start +) where + +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 +import qualified Database.SQLite.Simple as SQLite + +import qualified Sproxy.Logging as Log + + +type Database = Pool SQLite.Connection + +data DataSource = PostgreSQL String -- | File FilePath + +{- TODO: + - Hash remote tables and update the local only when the remote change + - Switch to REGEX + - Generalize sync procedures for different tables + -} + +start :: FilePath -> Maybe DataSource -> IO Database +start home ds = do + Log.info $ "home directory: " ++ show home + db <- createPool + (do c <- SQLite.open $ home ++ "/sproxy.sqlite3" + lvl <- Log.level + SQLite.setTrace c (if lvl == Log.Debug then Just $ Log.debug . unpack else Nothing) + return c) + SQLite.close + 1 -- stripes + 3600 -- keep alive (seconds). FIXME: no much sense as it's a local file + 128 -- max connections. FIXME: make configurable? + + withResource db $ \c -> SQLite.execute_ c "PRAGMA journal_mode=WAL" + populate db ds + return db + + +userExists :: Database -> String -> 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)" + [ ":email" := email ] + return $ head r + + +userGroups :: Database -> String -> Text -> Text -> Text -> IO [ByteString] +userGroups db email domain path method = + withResource db $ \c -> fmap (encodeUtf8 . 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 + AND gp.privilege IN ( + SELECT privilege FROM privilege_rule + WHERE :domain LIKE 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 + , ":method" := method -- XXX case-sensitive by RFC2616 + ] + + +populate :: Database -> Maybe DataSource -> IO () + +populate db Nothing = do + Log.warn "db: no data source defined" + withResource db $ \c -> SQLite.withTransaction c $ do + createGroupMember c + createGroupPrivilege c + createPrivilegeRule c + +-- XXX We keep only required minimum of the data, without any integrity check. +-- XXX Integrity check should be done somewhere else, e. g. in the master PostgreSQL database, +-- XXX or during importing the config file. +populate db (Just (PostgreSQL connstr)) = + void . forkIO . forever . flip finally (7 `minutes` threadDelay) + . logException $ do + Log.info $ "db: synchronizing with " ++ show connstr + withResource db $ \c -> SQLite.withTransaction c $ + bracket (PG.connectPostgreSQL $ pack connstr) PG.close $ + \pg -> PG.withTransaction pg $ do + + Log.info "db: syncing group_member" + dropGroupMember c + createGroupMember c + PG.forEach_ pg + [q|SELECT "group", lower(email) FROM group_member|] $ \r -> + SQLite.execute c + [q|INSERT INTO group_member("group", email) VALUES (?, ?)|] + (r :: (Text, Text)) + count c "group_member" + + Log.info "db: syncing group_privilege" + dropGroupPrivilege c + createGroupPrivilege c + PG.forEach_ pg + [q|SELECT "group", lower(domain), privilege FROM group_privilege|] $ \r -> + SQLite.execute c + [q|INSERT INTO group_privilege("group", domain, privilege) VALUES (?, ?, ?)|] + (r :: (Text, Text, Text)) + count c "group_privilege" + + Log.info "db: syncing privilege_rule" + dropPrivilegeRule c + createPrivilegeRule c + PG.forEach_ pg + [q|SELECT lower(domain), privilege, path, method FROM privilege_rule|] $ \r -> + SQLite.execute c + [q|INSERT INTO privilege_rule(domain, privilege, path, method) VALUES (?, ?, ?, ?)|] + (r :: (Text, Text, Text, Text)) + count c "privilege_rule" + + +dropGroupMember :: SQLite.Connection -> IO () +dropGroupMember c = SQLite.execute_ c "DROP TABLE IF EXISTS group_member" + +createGroupMember :: SQLite.Connection -> IO () +createGroupMember c = SQLite.execute_ c [q| + CREATE TABLE IF NOT EXISTS group_member ( + "group" TEXT, + email TEXT, + PRIMARY KEY ("group", email) + ) +|] + + +dropGroupPrivilege :: SQLite.Connection -> IO () +dropGroupPrivilege c = SQLite.execute_ c "DROP TABLE IF EXISTS group_privilege" + +createGroupPrivilege :: SQLite.Connection -> IO () +createGroupPrivilege c = SQLite.execute_ c [q| + CREATE TABLE IF NOT EXISTS group_privilege ( + "group" TEXT, + domain TEXT, + privilege TEXT, + PRIMARY KEY ("group", domain, privilege) + ) +|] + + +dropPrivilegeRule :: SQLite.Connection -> IO () +dropPrivilegeRule c = SQLite.execute_ c "DROP TABLE IF EXISTS privilege_rule" + +createPrivilegeRule :: SQLite.Connection -> IO () +createPrivilegeRule c = SQLite.execute_ c [q| + CREATE TABLE IF NOT EXISTS privilege_rule ( + domain TEXT, + privilege TEXT, + path TEXT, + method TEXT, + PRIMARY KEY (domain, path, method) + ) +|] + + +count :: SQLite.Connection -> String -> IO () +count c table = do + r <- fmap SQLite.fromOnly <$> SQLite.query_ c [qc|SELECT COUNT(*) FROM {table}|] + Log.info $ "db: " ++ table ++ " rows: " ++ show (head r :: Integer) + + +logException :: IO () -> IO () +logException a = catch a $ \e -> + Log.error $ "db: " ++ show (e :: SomeException) + + +minutes :: Int -> (Int -> IO ()) -> IO () +minutes us f = f $ us * 60 * 1000000 + |