Merge pull request #287 from Tarrasch/master
Remove kerberos support for yesod-auth
This commit is contained in:
Michael Snoyman
commit
65bf960e44
@ -1,25 +0,0 @@
|
|||||||
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.
|
|
||||||
@ -1,8 +0,0 @@
|
|||||||
#!/usr/bin/env runhaskell
|
|
||||||
|
|
||||||
> module Main where
|
|
||||||
> import Distribution.Simple
|
|
||||||
> import System.Cmd (system)
|
|
||||||
|
|
||||||
> main :: IO ()
|
|
||||||
> main = defaultMain
|
|
||||||
@ -1,123 +0,0 @@
|
|||||||
{-# 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 -> addHamlet
|
|
||||||
[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>
|
|
||||||
<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)
|
|
||||||
|
|
||||||
@ -1,10 +0,0 @@
|
|||||||
|
|
||||||
-- 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
|
|
||||||
@ -1,39 +0,0 @@
|
|||||||
name: yesod-auth-kerberos
|
|
||||||
version: 0.8.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
|
|
||||||
, bytestring >= 0.9.1.4 && < 0.10
|
|
||||||
, yesod-core >= 0.10 && < 0.11
|
|
||||||
, yesod-auth >= 0.8 && < 0.9
|
|
||||||
, text >= 0.7 && < 0.12
|
|
||||||
, hamlet >= 0.10 && < 0.11
|
|
||||||
, yesod-form >= 0.4 && < 0.5
|
|
||||||
, 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
|
|
||||||
@ -1,41 +0,0 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
||||||
import Yesod
|
|
||||||
import Yesod.Auth
|
|
||||||
import Yesod.Form
|
|
||||||
import Yesod.Auth.Kerberos
|
|
||||||
|
|
||||||
data Kerberos = Kerberos
|
|
||||||
|
|
||||||
mkYesod "Kerberos" [parseRoutes|
|
|
||||||
/ RootR GET
|
|
||||||
/after AfterLoginR GET
|
|
||||||
/auth AuthR Auth getAuth
|
|
||||||
|]
|
|
||||||
|
|
||||||
getRootR :: Handler ()
|
|
||||||
getRootR = redirect RedirectTemporary $ AuthR LoginR
|
|
||||||
|
|
||||||
getAfterLoginR :: Handler RepHtml
|
|
||||||
getAfterLoginR = defaultLayout $ return ()
|
|
||||||
|
|
||||||
instance Yesod Kerberos where
|
|
||||||
approot _ = "http://localhost:3000"
|
|
||||||
|
|
||||||
instance YesodAuth Kerberos where
|
|
||||||
type AuthId Kerberos = String
|
|
||||||
loginDest _ = AfterLoginR
|
|
||||||
logoutDest _ = AuthR LoginR
|
|
||||||
getAuthId _ = do
|
|
||||||
liftIO $ putStrLn "getAuthId"
|
|
||||||
return $ Just "foo"
|
|
||||||
authPlugins = [authKerberos]
|
|
||||||
|
|
||||||
instance RenderMessage Kerberos FormMessage where
|
|
||||||
renderMessage _ _ = defaultFormMessage
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = warpDebug 3000 Kerberos
|
|
||||||
Loading…
Reference in New Issue
Block a user