packages feed

gssapi-wai (empty) → 0.1.0.0

raw patch · 8 files changed

+322/−0 lines, 8 filesdep +basedep +base64-bytestringdep +bytestringsetup-changed

Dependencies added: base, base64-bytestring, bytestring, case-insensitive, gssapi, http-types, vault, wai, wai-extra

Files

+ LICENSE view
@@ -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.
+ README.md view
@@ -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)+````
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Main.hs view
@@ -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)
+ examples/haskell-gssapi-test.cabal view
@@ -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
+ examples/stack.yaml view
@@ -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: []
+ gssapi-wai.cabal view
@@ -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
+ src/Network/Wai/Middleware/SpnegoAuth.hs view
@@ -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 (== '@')