sproxy 0.9.4 → 0.9.5
raw patch · 4 files changed
+108/−71 lines, 4 files
Files
- ChangeLog.md +7/−0
- sproxy.cabal +6/−1
- src/ConfigFile.hs +3/−1
- src/Proxy.hs +92/−69
ChangeLog.md view
@@ -1,3 +1,10 @@+0.9.5+=====++* Allow running as unprivileged user: added option `user` in the configuration file.+* Default log level is `debug` if omitted in the configuration file.++ 0.9.4 =====
sproxy.cabal view
@@ -1,16 +1,21 @@ name: sproxy-version: 0.9.4+version: 0.9.5 synopsis: HTTP proxy for authenticating users via Google OAuth2 license: MIT license-file: LICENSE copyright: 2013-2016, Zalora South East Asia Pte. Ltd author: Chris Forno <jekor@jekor.com>+ , Igor Pashev <pashev.igor@gmail.com> maintainer: Igor Pashev <pashev.igor@gmail.com> category: Web build-type: Simple extra-source-files: README.md ChangeLog.md cabal-version: >=1.10 data-files: sproxy.sql++source-repository head+ type: git+ location: https://github.com/zalora/sproxy.git executable sproxy main-is: Main.hs
src/ConfigFile.hs view
@@ -38,11 +38,12 @@ , cfBackendAddress :: String , cfBackendPort :: Word16 , cfBackendSocket :: Maybe String+, cfUser :: String } deriving (Eq, Show) instance FromJSON ConfigFile where parseJSON (Object m) = ConfigFile <$>- (m .: "log_level" >>= parseLogLevel)+ (m .:? "log_level" .!= "debug" >>= parseLogLevel) <*> (m .:? "log_target" .!= "stderr" >>= parseLogTarget) <*> m .:? "listen" .!= 443 <*> m .:? "redirect_http_to_https"@@ -56,6 +57,7 @@ <*> m .:? "backend_address" .!= "127.0.0.1" <*> m .:? "backend_port" .!= 8080 <*> m .:? "backend_socket"+ <*> m .:? "user" .!= "sproxy" parseJSON _ = empty deriving instance Read LogLevel
src/Proxy.hs view
@@ -3,42 +3,48 @@ run ) where -import Control.Monad hiding (forM_)-import Data.Foldable (forM_) import Control.Concurrent import Control.Exception-import System.IO.Error-import GHC.IO.Exception-import Data.Monoid-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Lazy as BL+import Control.Monad hiding (forM_) import Data.Default (def)+import Data.Foldable (forM_) import Data.List (intercalate)-import Data.Maybe import Data.Map as Map (fromListWith, toList, insert, delete)+import Data.Maybe+import Data.Monoid import Data.String.Conversions (cs)+import GHC.IO.Exception+import Network (PortID(..), connectTo)+import Network.HTTP.Toolkit+import Network.HTTP.Types+import Network.Socket (accept, close, socket, listen, bind,+ maxListenQueue, getSocketName, Socket, SockAddr(SockAddrInet),+ Family(AF_INET), SocketType(Stream), setSocketOption,+ SocketOption(ReuseAddr))+import System.Entropy (getEntropy)+import System.IO+import System.IO.Error+import System.Posix.Directory (changeWorkingDirectory)+import System.Posix.User (getRealUserID, setGroupID, setUserID,+ getUserEntryForName, UserEntry(..), GroupEntry(..), setGroups,+ getAllGroupEntries)+import qualified Data.ByteString.Base64 as Base64+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL import qualified Data.X509 as X509-import Network (PortID(..), listenOn, sClose, connectTo)-import Network.Socket (Socket, SockAddr, accept, close) import qualified Network.Socket.ByteString as Socket-import Network.HTTP.Types import qualified Network.TLS as TLS import qualified Network.TLS.Extra as TLS-import System.IO-import System.Entropy (getEntropy)-import qualified Data.ByteString.Base64 as Base64-import Network.HTTP.Toolkit- import qualified System.Logging.Facade as Log -import Type-import Util-import Logging import Authenticate-import Cookies import Authorize import ConfigFile+import Cookies import HTTP+import Logging+import Type+import Util data Config = Config { configTLSCredential :: TLS.Credential@@ -51,6 +57,33 @@ run :: ConfigFile -> AuthorizeAction -> IO () run cf authorize = do Logging.setup (cfLogLevel cf) (cfLogTarget cf)++ sock <- socket AF_INET Stream 0+ setSocketOption sock ReuseAddr 1+ bind sock $ SockAddrInet (fromIntegral $ cfListen cf) 0++ sock80 <- if fromMaybe (443 == cfListen cf) (cfRedirectHttpToHttps cf)+ then do+ s <- socket AF_INET Stream 0+ setSocketOption s ReuseAddr 1+ bind s $ SockAddrInet 80 0+ return (Just s)+ else+ return Nothing++ uid <- getRealUserID+ when (0 == uid) $ do+ let user = cfUser cf+ u <- getUserEntryForName user+ groupIDs <- map groupID . filter (\g -> user `elem` groupMembers g)+ <$> getAllGroupEntries+ Log.info $ "Switching to user " ++ show user+ setGroups groupIDs+ setGroupID $ userGroupID u+ setUserID $ userID u+ changeWorkingDirectory (homeDirectory u)+ `catch` (\e -> logException e >> changeWorkingDirectory "/")+ clientSecret <- strip <$> readFile (cfClientSecretFile cf) authTokenKey <- B8.unpack . Base64.encode <$> getEntropy 32 credential <- either error reverseCerts <$> TLS.credentialLoadX509 (cfSslCerts cf) (cfSslKey cf)@@ -72,25 +105,21 @@ } case configBackendPortID config of- UnixSocket path -> hPutStrLn stderr $ "Forwarding to UNIX socket " ++ path- PortNumber p -> hPutStrLn stderr $ "Forwarding to "+ UnixSocket path -> Log.info $ "Backend on UNIX socket " ++ path+ PortNumber p -> Log.info $ "Backend on " ++ configBackendAddress config ++ ":" ++ show p _ -> return () -- XXX can't happen mvar <- newEmptyMVar - -- Immediately fork a new thread for accepting connections since- -- the main thread is special and expensive to communicate with.- void . forkIO $ (runProxy (PortNumber . fromIntegral $ cfListen cf)- config authConfig authorize `catch` logException)- `finally` putMVar mvar ()-- -- Listen on port 80 just to redirect everything to HTTPS.- let listen80 = fromMaybe (443 == cfListen cf) (cfRedirectHttpToHttps cf)+ void . forkIO $ (runOnSocket sock (serve config authConfig authorize) `catch` logException)+ `finally` (close sock >> putMVar mvar ()) - when listen80 $- void . forkIO $ listen (PortNumber 80) redirectToHttps `catch` logException+ case sock80 of+ Nothing -> return ()+ Just s -> void . forkIO $ (runOnSocket s redirectToHttps `catch` logException)+ `finally` close s takeMVar mvar where@@ -98,9 +127,6 @@ -- but the tls library expects them in the opposite order. reverseCerts (X509.CertificateChain certs, key) = (X509.CertificateChain $ reverse certs, key) -runProxy :: PortID -> Config -> AuthConfig -> AuthorizeAction -> IO ()-runProxy port config authConfig authorize = listen port (serve config authConfig authorize)- -- | Redirects requests to https. redirectToHttps :: SockAddr -> Socket -> IO () redirectToHttps _ sock = do@@ -203,46 +229,43 @@ [] -> delete hCookie _ -> insert hCookie (formatCookies cookies) -listen :: PortID -> (SockAddr -> Socket -> IO ()) -> IO ()-listen port action =- bracket- ( do- sock <- listenOn port- hPutStrLn stderr $ "Listening on " ++ show port- return sock )- sClose $- \serverSock -> forever $ do- (sock, addr) <- accept serverSock- forkIO $ (action addr sock `finally` close sock) `catches` handlers- where- handlers = [ Handler ioH- , Handler toolkitH- , Handler tlsH- , Handler logException ]+runOnSocket :: Socket -> (SockAddr -> Socket -> IO ()) -> IO ()+runOnSocket serverSock action = do+ listen serverSock maxListenQueue+ name <- getSocketName serverSock+ Log.info $ "Listening on " ++ show name+ forever $ do+ (sock, addr) <- accept serverSock+ forkIO $ (action addr sock `finally` close sock) `catches` handlers+ where+ handlers = [ Handler ioH+ , Handler toolkitH+ , Handler tlsH+ , Handler logException ] - ioH :: IOException -> IO ()- ioH e- | ResourceVanished == ioeGetErrorType e = clientClosedConection e- | otherwise = logException' e+ ioH :: IOException -> IO ()+ ioH e+ | ResourceVanished == ioeGetErrorType e = clientClosedConection e+ | otherwise = logException' e - toolkitH :: ToolkitError -> IO ()- toolkitH e@UnexpectedEndOfInput = clientClosedConection e- toolkitH e = logException' e+ toolkitH :: ToolkitError -> IO ()+ toolkitH e@UnexpectedEndOfInput = clientClosedConection e+ toolkitH e = logException' e - tlsH :: TLS.TLSException -> IO ()- 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 = logException' e+ tlsH :: TLS.TLSException -> IO ()+ 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 = logException' e - logException' :: Exception e => e -> IO ()- logException' = logException . toException+ logException' :: Exception e => e -> IO ()+ logException' = logException . toException - clientClosedConection :: Exception e => e -> IO ()- clientClosedConection e = Log.debug ("client closed connection (" ++ displayException e ++ ")")+ clientClosedConection :: Exception e => e -> IO ()+ clientClosedConection e = Log.debug ("client closed connection (" ++ displayException e ++ ")") - clientError :: Exception e => e -> IO ()- clientError e = Log.debug ("client error (" ++ displayException e ++ ")")+ clientError :: Exception e => e -> IO ()+ clientError e = Log.debug ("client error (" ++ displayException e ++ ")") logException :: SomeException -> IO () logException = Log.error . displayException