diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Ondrej Palkovsky + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ondrej Palkovsky nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,48 @@ +[![Build Status](https://travis-ci.org/ondrap/gssapi-wai.svg?branch=master)](https://travis-ci.org/ondrap/gssapi-wai) [![Hackage](https://img.shields.io/hackage/v/gssapi-wai.svg)](https://hackage.haskell.org/package/gssapi-wai) + +## GSSAPI and Kerberos bindings for Haskell + +See haskell [gssapi](http://github.com/ondrap/gssapi) package +for tutorial how to set up kerberos authentication with Windows AD. + +This module is modelled after [spnego-http-auth-nginx-module](https://github.com/stnoonan/spnego-http-auth-nginx-module). +If you are using it to provide auth, it should be reasonably easy to use this module instead. + + +#### The application + +Generally you need to use TLS, otherwise browsers refuse to use SPNEGO authentication. +The library provides wai middleware component to ease use. The username is saved +to a vault. + +````haskell +{-# LANGUAGE OverloadedStrings #-} +module Main where +import Data.ByteString.Lazy.Char8 (fromStrict) +import Data.Function ((&)) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import qualified Data.Vault.Lazy as V +import Network.HTTP.Types (status200) +import Network.HTTP.Types.Header (hContentType) +import Network.Wai (Application, responseLBS, + vault) +import Network.Wai.Handler.Warp (defaultSettings, setPort) +import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings) + +import Network.Wai.Middleware.SpnegoAuth + +app :: Application +app req respond = do + let user = fromMaybe "no-user-found?" (V.lookup spnegoAuthKey (vault req)) + respond $ responseLBS status200 [(hContentType, "text/plain")] ("Hello " <> fromStrict user) + +main :: IO () +main = do + let port = 3000 + settings = defaultSettings & setPort port + tsettings = tlsSettings "cert.pem" "key.pem" + authSettings = defaultSpnegoSettings{spnegoRealm=Just "EXAMPLE.COM"} + putStrLn $ "Listening on port " ++ show port + runTLS tsettings settings (spnegoAuth authSettings app) +```` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/Main.hs b/examples/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Main.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Data.ByteString.Lazy.Char8 (fromStrict) +import Data.Function ((&)) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import qualified Data.Vault.Lazy as V +import Network.HTTP.Types (status200) +import Network.HTTP.Types.Header (hContentType) +import Network.Wai (Application, responseLBS, + vault) +import Network.Wai.Handler.Warp (defaultSettings, setPort) +import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings) + +import Network.Wai.Middleware.SpnegoAuth + +app :: Application +app req respond = do + let user = fromMaybe "no-user-found?" (V.lookup spnegoAuthKey (vault req)) + respond $ responseLBS status200 [(hContentType, "text/plain")] ("Hello " <> fromStrict user) + +main :: IO () +main = do + let port = 3000 + settings = defaultSettings & setPort port + tsettings = tlsSettings "cert.pem" "key.pem" + authSettings = defaultSpnegoSettings{spnegoRealm=Just "EXAMPLE.COM"} + putStrLn $ "Listening on port " ++ show port + runTLS tsettings settings (spnegoAuth authSettings app) diff --git a/examples/haskell-gssapi-test.cabal b/examples/haskell-gssapi-test.cabal new file mode 100644 --- /dev/null +++ b/examples/haskell-gssapi-test.cabal @@ -0,0 +1,19 @@ +name: haskell-gssapi-test +version: 0.1.0.0 +synopsis: Test web server from gssapi +license: BSD3 +author: Ondrej Palkovsky +maintainer: palkovsky.ondrej@gmail.com +copyright: Ondrej Palkovsky +category: Network +build-type: Simple +cabal-version: >=1.10 + +executable test + build-depends: base >=4.8 && <4.10, gssapi-wai, bytestring, + resourcet, transformers, warp, wai, http-types, + case-insensitive, base64-bytestring, warp-tls, + vault + main-is: Main.hs + ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded + default-language: Haskell2010 diff --git a/examples/stack.yaml b/examples/stack.yaml new file mode 100644 --- /dev/null +++ b/examples/stack.yaml @@ -0,0 +1,15 @@ +allow-different-user: true + +resolver: lts-6.24 + +packages: +- '.' +- '..' +- '../../gssapi' +extra-deps: [] + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] diff --git a/gssapi-wai.cabal b/gssapi-wai.cabal new file mode 100644 --- /dev/null +++ b/gssapi-wai.cabal @@ -0,0 +1,30 @@ +name: gssapi-wai +version: 0.1.0.0 +synopsis: WAI Middleware for SPNEGO authentiaction +description: Basic WAI Middleware allows both SPNEGO and failback to Kerberos + username/password authentication. + +license: BSD3 +license-file: LICENSE +author: Ondrej Palkovsky +maintainer: palkovsky.ondrej@gmail.com +homepage: https://github.com/ondrap/gssapi-wai +copyright: Ondrej Palkovsky +category: Network +build-type: Simple +extra-source-files: examples/Main.hs examples/stack.yaml examples/haskell-gssapi-test.cabal README.md +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/ondrap/gssapi-wai.git + +library + exposed-modules: Network.Wai.Middleware.SpnegoAuth + + build-depends: base >=4.8 && <4.10, gssapi, wai, wai-extra, + vault, base64-bytestring, bytestring, case-insensitive, + http-types + default-language: Haskell2010 + ghc-options: -Wall -fwarn-incomplete-uni-patterns + hs-source-dirs: src diff --git a/src/Network/Wai/Middleware/SpnegoAuth.hs b/src/Network/Wai/Middleware/SpnegoAuth.hs new file mode 100644 --- /dev/null +++ b/src/Network/Wai/Middleware/SpnegoAuth.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | +-- Module : Network.Wai.Middleware.SpnegoAuth +-- License : BSD-style +-- +-- Maintainer : palkovsky.ondrej@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- WAI Middleware for SPNEGO authentication with failback to Basic authentication, where +-- the username/password is checked using Kerberos library (i.e. kinit user@EXAMPLE.COM). + +module Network.Wai.Middleware.SpnegoAuth ( + spnegoAuth + , SpnegoAuthSettings(..) + , defaultSpnegoSettings + , spnegoAuthKey +) where + +import Control.Arrow (second) +import Control.Exception (catch) +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as BS +import qualified Data.CaseInsensitive as CI +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import qualified Data.Vault.Lazy as V +import Network.HTTP.Types (status401) +import Network.HTTP.Types.Header (hAuthorization, + hWWWAuthenticate) +import Network.Wai (Application, Middleware, + Request (..), + mapResponseHeaders, + responseLBS) +import Network.Wai.Middleware.HttpAuth (extractBasicAuth) +import System.IO.Unsafe + +import Network.Security.GssApi +import Network.Security.Kerberos + +-- | Configuration structure for `spnegoAuth` middleware +data SpnegoAuthSettings = SpnegoAuthSettings { + spnegoRealm :: Maybe BS.ByteString -- ^ Realm to use with both kerberos and spnego authentication. + , spnegoService :: Maybe BS.ByteString -- ^ If set, use 'spnegoService@spnegoRealm' credentials from the keytab. + -- May contain the whole principal, in such case `spnegoRealm` is used only for + -- kerberos user/password authentication. + , spnegoUserFull :: Bool -- ^ Always return full user principal; normally, if the user realm is equal to spnegoRealm, + -- the realm is stripped + , spnegoBasicFailback :: Bool -- ^ Allow failback to basic auth (username/password with kerberos api) + , spnegoForceRealm :: Bool -- ^ Force use of `spnegoRealm` or default system realm in basic auth failback + , spnegoOnAuthError :: SpnegoAuthSettings -> Maybe (Either KrbException GssException) -> Application + -- ^ Called upon GSSAPI/Kerberos error. It is supposed to return 401 return code with + -- 'Authorize: Negotiate' and possibly 'Authorize: Basic realm=...' headers + , spnegoFakeBasicAuth :: Bool -- ^ Fake 'Authorization: ' basic header for applications relying on Basic auth +} + +-- | Default settings for `spnegoAuth` middleware +defaultSpnegoSettings :: SpnegoAuthSettings +defaultSpnegoSettings = SpnegoAuthSettings { + spnegoRealm = Nothing + , spnegoService = Nothing + , spnegoUserFull = False + , spnegoBasicFailback = True + , spnegoForceRealm = True + , spnegoOnAuthError = authError + , spnegoFakeBasicAuth = False + } + where + authHeaders SpnegoAuthSettings{spnegoBasicFailback=True, spnegoRealm=Just realm} = + [(hWWWAuthenticate, "Negotiate"), (hWWWAuthenticate, "Basic realm=\"" <> realm <> "\"")] + authHeaders SpnegoAuthSettings{spnegoBasicFailback=True, spnegoRealm=Nothing} = + [(hWWWAuthenticate, "Negotiate"), (hWWWAuthenticate, "Basic realm=\"Auth\"")] + authHeaders SpnegoAuthSettings{spnegoBasicFailback=False} = [(hWWWAuthenticate, "Negotiate")] + + baseResponse settings respond = respond $ responseLBS status401 (authHeaders settings) "Unauthorized" + + authError settings Nothing _ respond = baseResponse settings respond + authError settings (Just (Left (KrbException _ err))) _ respond = do + putStrLn $ "Kerberos error: " <> show err + baseResponse settings respond + authError settings (Just (Right (GssException _ err))) _ respond = do + putStrLn $ "GSSAPI error: " <> show err + baseResponse settings respond + +-- | Key that is used to access the username in WAI vault +spnegoAuthKey :: V.Key BS.ByteString +spnegoAuthKey = unsafePerformIO V.newKey +{-# NOINLINE spnegoAuthKey #-} + +-- | Middleware that provides SSO capabilites +spnegoAuth :: SpnegoAuthSettings -> Middleware +spnegoAuth settings@SpnegoAuthSettings{..} iapp req respond = do + let hdrs = requestHeaders req + case lookup hAuthorization hdrs of + Just val + | Just token <- getSpnegoToken val -> + runSpnegoCheck token `catch` (\exc -> spnegoOnAuthError settings (Just (Right exc)) req respond) + | Just (user, password) <- extractBasicAuth val -> + runKerberosCheck user password `catch` (\exc -> spnegoOnAuthError settings (Just (Left exc)) req respond) + _ -> spnegoOnAuthError settings Nothing req respond + where + insertUserToVault user myreq = myreq{vault = vault'} + where + vault' = V.insert spnegoAuthKey (stripSpnegoRealm user) (vault myreq) + fakeAuth user myreq + | spnegoFakeBasicAuth = + let oldHeaders = requestHeaders myreq + fakeHeader = (hAuthorization, "Basic " <> B64.encode (user <> ":password")) + in myreq{requestHeaders=fakeHeader : oldHeaders} + | otherwise = myreq + + modifyKrbUser orig_user + | spnegoForceRealm = user <> fromMaybe "" (("@" <>) <$> spnegoRealm) + | BS.null realm, Just newrealm <- spnegoRealm = user <> "@" <> newrealm + | otherwise = orig_user + where + (user, realm) = splitPrincipal orig_user + + runKerberosCheck origuser password = do + user <- krb5Resolve (modifyKrbUser origuser) + krb5Login user password -- throws exception in case of error + iapp (insertUserToVault user req) respond + + runSpnegoCheck token = do + let service + | (BS.elem '@' <$> spnegoService) == Just True = spnegoService + | otherwise = (<> fromMaybe "" (("@" <>) <$> spnegoRealm)) <$> spnegoService + (user, output) <- runGssCheck service token + let neghdr = (hWWWAuthenticate, "Negotiate " <> B64.encode output) + iapp (fakeAuth user $ insertUserToVault user req) (respond . mapResponseHeaders (neghdr :)) + + -- Strip Realm, if spnegoUserFull is not set and the realm equals to spnegoRealm + stripSpnegoRealm user + | not spnegoUserFull, (clservice, clrealm) <- splitPrincipal user, + Just clrealm == spnegoRealm = clservice + | otherwise = user + + getSpnegoToken :: BS.ByteString -> Maybe BS.ByteString + getSpnegoToken val + | CI.mk w1 == "negotiate" = either (const Nothing) Just (B64.decode $ BS.drop 1 w2) + | otherwise = Nothing + where + (w1, w2) = BS.break (==' ') val + +splitPrincipal :: BS.ByteString -> (BS.ByteString, BS.ByteString) +splitPrincipal = second (BS.drop 1) . BS.break (== '@')