yesod-auth-kerberos (empty) → 1.0.0

raw patch · 5 files changed

+205/−0 lines, 5 filesdep +authenticate-kerberosdep +basedep +bytestringsetup-changed

Dependencies added: authenticate-kerberos, base, bytestring, hamlet, text, transformers, yesod-auth, yesod-core, yesod-form

Files

• LICENSE +25/−0
• Setup.lhs +8/−0
• Yesod/Auth/Kerberos.hs +123/−0
• include/qq.h +10/−0
• yesod-auth-kerberos.cabal +39/−0

@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2010, Michael Snoyman. 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.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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.

@@ -0,0 +1,8 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple+> import System.Cmd (system)++> main :: IO ()+> main = defaultMain

@@ -0,0 +1,123 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+-- | In-built kerberos authentication for Yesod.+--+-- Please note that all configuration should have been done+-- manually on the machine prior to running the code.+--+-- On linux machines the configuration might be in /etc/krb5.conf.+-- It's worth checking if the Kerberos service provider (e.g. your university)+-- already provide a complete configuration file.+--+-- Be certain that you can manually login from a shell by typing+--+-- > kinit username+--+-- If you fill in your password and the program returns no error code,+-- then your kerberos configuration is setup properly.+-- Only then can this module be of any use.+module Yesod.Auth.Kerberos+    ( authKerberos,+      genericAuthKerberos,+      KerberosConfig(..),+      defaultKerberosConfig+    ) where++#include "qq.h"++import Yesod.Auth+import Yesod.Auth.Message+import Web.Authenticate.Kerberos+import Data.Text (Text)+import qualified Data.Text as T+import Text.Hamlet+import Yesod.Handler+import Yesod.Widget+import Control.Monad.IO.Class (liftIO)+import Yesod.Form+import Control.Applicative ((<$>), (<*>))++data KerberosConfig = KerberosConfig {+    -- | When a user gives username x, f(x) will be passed to Kerberos+    usernameModifier :: Text -> Text+    -- | When a user gives username x, f(x) will be passed to Yesod+  , identifierModifier :: Text -> Text+  }++-- | A configuration where the username the user provides is the one passed+-- to both kerberos and yesod+defaultKerberosConfig :: KerberosConfig+defaultKerberosConfig = KerberosConfig id id++-- | A configurable version of 'authKerberos'+genericAuthKerberos :: YesodAuth m => KerberosConfig -> AuthPlugin m+genericAuthKerberos config = AuthPlugin "kerberos" dispatch $ \tm -> toWidget+    [QQ(hamlet)|+    <div id="header">+        <h1>Login++    <div id="login">+        <form method="post" action="@{tm login}">+            <table>+                <tr>+                    <th>Username:+                    <td>+                        <input id="x" name="username" autofocus="" required>+                <tr>+                    <th>Password:+                    <td>+                        <input type="password" name="password" required>+                <tr>+                    <td>&nbsp;+                    <td>+                        <input type="submit" value="Login">++            <script>+                if (!("autofocus" in document.createElement("input"))) {+                    document.getElementById("x").focus();+                }+|]+  where+    dispatch "POST" ["login"] = postLoginR config >>= sendResponse+    dispatch _ _              = notFound++login :: AuthRoute+login = PluginR "kerberos" ["login"]++-- | Kerberos with 'defaultKerberosConfig'+authKerberos :: YesodAuth m => AuthPlugin m+authKerberos = genericAuthKerberos defaultKerberosConfig++-- | Handle the login form+postLoginR :: (YesodAuth y) => KerberosConfig -> GHandler Auth y ()+postLoginR config = do+    (mu,mp) <- runInputPost $ (,)+        <$> iopt textField "username"+        <*> iopt textField "password"++    let errorMessage (message :: Text) = do+        setMessage [QQ(shamlet)|Error: #{message}|]+        toMaster <- getRouteToMaster+        redirect $ toMaster LoginR++    case (mu,mp) of+        (Nothing, _      ) -> do+            mr <- getMessageRender+            errorMessage $ mr PleaseProvideUsername+        (_      , Nothing) -> do+            mr <- getMessageRender+            errorMessage $ mr PleaseProvidePassword+        (Just u , Just p ) -> do+          result <- liftIO $ loginKerberos (usernameModifier config u) p+          case result of+            Ok -> do+                let creds = Creds+                      { credsIdent  = identifierModifier config u+                      , credsPlugin = "Kerberos"+                      , credsExtra  = []+                      }+                setCreds True creds+            kerberosError -> errorMessage (T.pack $ show kerberosError)+

@@ -0,0 +1,10 @@++-- CPP macro which choses which quasyquotes syntax to use depending+-- on GHC version.+--+-- QQ stands for quasyquote.+#if GHC7+# define QQ(x) x+#else+# define QQ(x) $x+#endif

@@ -0,0 +1,39 @@+name:            yesod-auth-kerberos+version:         1.0.0+license:         BSD3+license-file:    LICENSE+author:          Arash Rouhani+maintainer:      Arash Rouhani+synopsis:        Kerberos Authentication for Yesod.+category:        Web, Yesod+stability:       Stable+cabal-version:   >= 1.6.0+build-type:      Simple+homepage:        http://www.yesodweb.com/+extra-source-files: include/qq.h+description:     Kerberos Authentication for Yesod.++flag ghc7++library+    if flag(ghc7)+        build-depends:   base                >= 4.3      && < 5+        cpp-options:     -DGHC7+    else+        build-depends:   base                >= 4        && < 4.3+    build-depends:   authenticate-kerberos   >= 1.0       && < 1.1+                   , yesod-core              >= 1.0.0     && < 2.0.0+                   , yesod-auth              >= 1.0.0     && < 2.0.0+                   , yesod-form              >= 1.0.0     && < 2.0.0+                   , hamlet                  >= 1.0.0     && < 2.0.0+                   , bytestring              >= 0.9.1.4   && < 0.10+                   , text                    >= 0.7       && < 0.12+                   , transformers            >= 0.2.2     && < 0.3++    exposed-modules: Yesod.Auth.Kerberos+    ghc-options:     -Wall+    include-dirs: include++source-repository head+  type:     git+  location: https://github.com/yesodweb/yesod