sproxy 0.9.5 → 0.9.6
raw patch · 8 files changed
+191/−51 lines, 8 filesdep +textdep −logging-facadedep −logsink
Dependencies added: text
Dependencies removed: logging-facade, logsink
Files
- ChangeLog.md +10/−2
- config/sproxy.yml.example +57/−0
- sproxy.cabal +3/−4
- src/Authenticate.hs +11/−10
- src/ConfigFile.hs +11/−27
- src/HTTP.hs +1/−1
- src/Logging.hs +93/−4
- src/Proxy.hs +5/−3
ChangeLog.md view
@@ -1,3 +1,13 @@+0.9.6+=====++* Session shelf life is configurable with the `session_shelf_life` option+ in configuration file. Defaults to 30 days. It was hard-coded before.+* Dropped dependency on `logsink` / `logging-facade` (fail to build).+ Log to stderr only, log levels: error, warning, info, debug.+ The `log_target` option is ignored.++ 0.9.5 ===== @@ -32,10 +42,8 @@ ===== * Deny SSLv3.- * Removed the `auth_token_key` option from the config file. The token is generated randomly on startup. Restarting sproxy invalidates existing sessions.- * Added `ChangeLog.md`
+ config/sproxy.yml.example view
@@ -0,0 +1,57 @@+# Log level: debug, info, warn, error+# Default is debug+# log_level: debug++# The port sproxy listens on (this is always HTTPS).+# Default is 443+# listen: 443++# User to run as.+# If launched with root privileges, sproxy will switch+# to this user after openning the ports (443 and 80).+# Default is "sproxy"+# user: sproxy++# yes / no+# If 'yes', sproxy will open port 80 and redirect HTTP requests+# to the above listen port. Default is "yes" if listen is 443+# redirect_http_to_https: yes++cookie_domain: dev.zalora.com+cookie_name: sproxy-dev++# The client ID and client secret come from Google's "Cloud Console".+client_id: a611zak494jxdgdn6ltlkn547rme91ig.apps.googleusercontent.com+client_secret: config/client_secret++ssl_key: config/server.key.example++# Include extra (intermediate) certs in a single file. Make sure that they're sorted from server downward, i.e.:+# -----BEGIN CERTIFICATE-----+# (server certificate)+# -----END CERTIFICATE-----+# -----BEGIN CERTIFICATE-----+# (intermediate certificate)+# -----END CERTIFICATE-----+# -----BEGIN CERTIFICATE-----+# (optional CA certificate)+# -----END CERTIFICATE-----+ssl_certs: config/server.crt.example++# PostgreSQL database connection string+database: "user=you dbname=sproxy"++# To initialize/populate the DB, see sproxy.sql.++# Which backend should sproxy relay the requests to?+# Default is 127.0.0.1:8080, ignored if backend_socket is set+# backend_address: "127.0.0.1"+# backend_port: 8080++# If specified, connect to this UNIX-socket instead of TCP+# backend_socket: "/tmp/foo.sock"++# Sproxy session shelf life in seconds, default is 30 days.+# When expired, Sproxy will require re-authenticate.+# session_shelf_life: 2592000+
sproxy.cabal view
@@ -1,5 +1,5 @@ name: sproxy-version: 0.9.5+version: 0.9.6 synopsis: HTTP proxy for authenticating users via Google OAuth2 license: MIT license-file: LICENSE@@ -9,7 +9,7 @@ maintainer: Igor Pashev <pashev.igor@gmail.com> category: Web build-type: Simple-extra-source-files: README.md ChangeLog.md+extra-source-files: README.md ChangeLog.md config/sproxy.yml.example cabal-version: >=1.10 data-files: sproxy.sql @@ -48,14 +48,13 @@ , http-kit >= 0.5 , http-types >= 0.8.5 , interpolatedstring-perl6- , logging-facade- , logsink , network , postgresql-simple , raw-strings-qq >= 1.1 , resource-pool , split , string-conversions+ , text , time , tls >= 1.3.3 , unix
src/Authenticate.hs view
@@ -32,10 +32,10 @@ import qualified Network.HTTP.Conduit as HTTP import Network.HTTP.Toolkit -import qualified System.Logging.Facade as Log import Cookies import HTTP+import qualified Logging as Log data AuthConfig = AuthConfig { authConfigCookieDomain :: String@@ -43,6 +43,7 @@ , authConfigClientID :: String , authConfigClientSecret :: String , authConfigAuthTokenKey :: String+, authConfigShelfLife :: EpochTime } deriving (Eq, Show) data AccessToken = AccessToken {@@ -124,15 +125,14 @@ case decode body of Nothing -> authenticationFailed "Received an invalid user info response from Google's authentication server." Just userInfo -> do- clientToken <- authToken authTokenKey (userEmail userInfo) (userGivenName userInfo, userFamilyName userInfo)- let cookie = setCookie cookieDomain cookieName (show clientToken) authShelfLife+ clientToken <- authToken config userInfo+ let cookie = setCookie cookieDomain cookieName (show clientToken) (authConfigShelfLife config) mkResponse found302 [("Location", baseUri <> urlDecode False path), ("Set-Cookie", UTF8.fromString cookie)] "" where cookieDomain = authConfigCookieDomain config cookieName = authConfigCookieName config clientID = authConfigClientID config clientSecret = authConfigClientSecret config- authTokenKey = authConfigAuthTokenKey config logout :: AuthConfig -> ByteString -> IO (Response BodyReader) logout config url = do@@ -168,11 +168,14 @@ -- | Create an AuthToken with the default expiration time, automatically -- calculating the digest.-authToken :: String -> String -> (String, String) -> IO AuthToken-authToken key email name = do+authToken :: AuthConfig -> UserInfo -> IO AuthToken+authToken acfg user = do now <- epochTime- let expires = now + authShelfLife- digest = tokenDigest key AuthToken {+ let+ email = userEmail user+ name = (userGivenName user, userFamilyName user)+ expires = now + authConfigShelfLife acfg+ digest = tokenDigest (authConfigAuthTokenKey acfg) AuthToken { authEmail = email , authName = name , authExpiry = expires@@ -194,5 +197,3 @@ tokenDigest key a = showDigest $ hmacSha1 (BL8.pack key) (BL8.pack token) where token = show (authEmail a) ++ show (authExpiry a) -authShelfLife :: EpochTime-authShelfLife = 30 * 24 * 60 * 60 -- 30 days
src/ConfigFile.hs view
@@ -1,19 +1,16 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} module ConfigFile where import Control.Applicative-import Data.Char-import Data.Word-import Text.Read-import System.IO-import System.Exit import Data.Aeson+import Data.Word import Data.Yaml-import System.Logging.LogSink.Config+import System.Exit+import System.IO +import Logging (LogLevel(Debug))+ withConfigFile :: FilePath -> (ConfigFile -> IO a) -> IO a withConfigFile configFile action = do c <- decodeFileEither configFile@@ -24,9 +21,8 @@ Right config -> action config data ConfigFile = ConfigFile {- cfLogLevel :: LogLevel-, cfLogTarget :: LogTarget-, cfListen :: Word16+ cfListen :: Word16+, cfLogLevel :: LogLevel , cfRedirectHttpToHttps :: Maybe Bool , cfCookieDomain :: String , cfCookieName :: String@@ -39,13 +35,13 @@ , cfBackendPort :: Word16 , cfBackendSocket :: Maybe String , cfUser :: String+, cfSessionShelfLife :: Word32 } deriving (Eq, Show) instance FromJSON ConfigFile where parseJSON (Object m) = ConfigFile <$>- (m .:? "log_level" .!= "debug" >>= parseLogLevel)- <*> (m .:? "log_target" .!= "stderr" >>= parseLogTarget)- <*> m .:? "listen" .!= 443+ m .:? "listen" .!= 443+ <*> m .:? "log_level" .!= Debug <*> m .:? "redirect_http_to_https" <*> m .: "cookie_domain" <*> m .: "cookie_name"@@ -58,18 +54,6 @@ <*> m .:? "backend_port" .!= 8080 <*> m .:? "backend_socket" <*> m .:? "user" .!= "sproxy"+ <*> m .:? "session_shelf_life" .!= (30 * 24 * 60 * 60) parseJSON _ = empty--deriving instance Read LogLevel--parseLogLevel :: String -> Parser LogLevel-parseLogLevel s = (maybe err return . readMaybe . map toUpper) s- where- err = fail ("invalid log_level " ++ show s)--parseLogTarget :: String -> Parser LogTarget-parseLogTarget s = case s of- "stderr" -> return StdErr- "syslog" -> return SysLog- _ -> fail ("invalid log_target " ++ show s)
src/HTTP.hs view
@@ -16,7 +16,7 @@ import Network.HTTP.Toolkit.Body import Text.InterpolatedString.Perl6 (qc) -import qualified System.Logging.Facade as Log+import qualified Logging as Log hostHeaderMissing :: Request a -> IO (Response BodyReader) hostHeaderMissing r = do
src/Logging.hs view
@@ -1,6 +1,95 @@-module Logging (setup) where+module Logging (+ LogLevel(..)+, error+, debug+, info+, start+, warn+) where -import System.Logging.LogSink.Config+import Prelude hiding (error) -setup :: LogLevel -> LogTarget -> IO ()-setup level target = setupLogging [SinkConfig level "{level} {thread-id}: {message}" target]+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 <- readIORef logLevel+ 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)+++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 `elem` ["none"] = [ (None, "") ]+ | l `elem` ["error"] = [ (Error, "") ]+ | l `elem` ["warn", "warning"] = [ (Warning, "") ]+ | l `elem` ["info"] = [ (Info, "") ]+ | l `elem` ["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+
src/Proxy.hs view
@@ -28,6 +28,7 @@ import System.Posix.User (getRealUserID, setGroupID, setUserID, getUserEntryForName, UserEntry(..), GroupEntry(..), setGroups, getAllGroupEntries)+import Foreign.C.Types (CTime(..)) import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL@@ -35,16 +36,15 @@ import qualified Network.Socket.ByteString as Socket import qualified Network.TLS as TLS import qualified Network.TLS.Extra as TLS-import qualified System.Logging.Facade as Log import Authenticate import Authorize import ConfigFile import Cookies import HTTP-import Logging import Type import Util+import qualified Logging as Log data Config = Config { configTLSCredential :: TLS.Credential@@ -56,7 +56,7 @@ -- the server run :: ConfigFile -> AuthorizeAction -> IO () run cf authorize = do- Logging.setup (cfLogLevel cf) (cfLogTarget cf)+ Log.start (cfLogLevel cf) sock <- socket AF_INET Stream 0 setSocketOption sock ReuseAddr 1@@ -94,6 +94,7 @@ , authConfigClientID = cfClientID cf , authConfigClientSecret = clientSecret , authConfigAuthTokenKey = authTokenKey+ , authConfigShelfLife = CTime . fromIntegral $ cfSessionShelfLife cf } config = Config { configTLSCredential = credential@@ -256,6 +257,7 @@ tlsH e@(TLS.HandshakeFailed TLS.Error_EOF) = clientClosedConection e tlsH e@(TLS.HandshakeFailed (TLS.Error_Protocol (_, _, _))) = clientError e tlsH e@(TLS.HandshakeFailed (TLS.Error_Packet_Parsing _)) = clientError e+ tlsH e@(TLS.HandshakeFailed (TLS.Error_Misc _)) = clientError e tlsH e = logException' e logException' :: Exception e => e -> IO ()