diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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` diff --git a/config/sproxy.yml.example b/config/sproxy.yml.example new file mode 100644 --- /dev/null +++ b/config/sproxy.yml.example @@ -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 + diff --git a/sproxy.cabal b/sproxy.cabal --- a/sproxy.cabal +++ b/sproxy.cabal @@ -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 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 diff --git a/src/Authenticate.hs b/src/Authenticate.hs --- a/src/Authenticate.hs +++ b/src/Authenticate.hs @@ -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 diff --git a/src/ConfigFile.hs b/src/ConfigFile.hs --- a/src/ConfigFile.hs +++ b/src/ConfigFile.hs @@ -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) diff --git a/src/HTTP.hs b/src/HTTP.hs --- a/src/HTTP.hs +++ b/src/HTTP.hs @@ -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 diff --git a/src/Logging.hs b/src/Logging.hs --- a/src/Logging.hs +++ b/src/Logging.hs @@ -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 + diff --git a/src/Proxy.hs b/src/Proxy.hs --- a/src/Proxy.hs +++ b/src/Proxy.hs @@ -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 ()