haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #287 from Tarrasch/master

Browse Source 
Remove kerberos support for yesod-auth
This commit is contained in:
Michael Snoyman 2012-03-10 09:32:25 -08:00
commit 65bf960e44
6 changed files with 0 additions and 246 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
yesod-auth-kerberos/LICENSE
View File

@ -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.

8
yesod-auth-kerberos/Setup.lhs
View File

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

123
yesod-auth-kerberos/Yesod/Auth/Kerberos.hs
View File

@ -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>&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)

10
yesod-auth-kerberos/include/qq.h
View File

@ -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

39
yesod-auth-kerberos/yesod-auth-kerberos.cabal
View File

@ -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

41
yesod-auth/kerberos.hs
View File

@ -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