Merge branch 'master' of github.com:yesodweb/authenticate
This commit is contained in:
Hiromi Ishii
commit
fd67f12be9
@ -1,25 +0,0 @@
|
|||||||
The following license covers this documentation, and the source code, except
|
|
||||||
where otherwise indicated.
|
|
||||||
|
|
||||||
Copyright 2008, 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,43 +0,0 @@
|
|||||||
#!/usr/bin/env runhaskell
|
|
||||||
|
|
||||||
> module Main where
|
|
||||||
> import Distribution.Simple
|
|
||||||
> import System.Process (readProcessWithExitCode)
|
|
||||||
> import System.Exit (ExitCode(..))
|
|
||||||
> import System.Directory (removeFile)
|
|
||||||
> import System.IO.Error (try)
|
|
||||||
|
|
||||||
> main :: IO ()
|
|
||||||
> main = defaultMainWithHooks simpleUserHooks'
|
|
||||||
> where
|
|
||||||
> simpleUserHooks' = simpleUserHooks
|
|
||||||
> { postConf = postConf'
|
|
||||||
> , postClean = postClean'
|
|
||||||
> }
|
|
||||||
>
|
|
||||||
> postConf' x configFlags desc y = do
|
|
||||||
> hconf <- checkHeimKinit
|
|
||||||
> writeFile "config.h" $ concat
|
|
||||||
> [ "#ifndef CONFIG_H\n"
|
|
||||||
> , "#define CONFIG_H\n"
|
|
||||||
> , "\n"
|
|
||||||
> , "/* Define to 1 if you have Heimdal Kerberos. */\n"
|
|
||||||
> , hconf
|
|
||||||
> , "\n\n"
|
|
||||||
> , "#endif\n"
|
|
||||||
> ]
|
|
||||||
> let configFlags' = updateConfigFlags configFlags
|
|
||||||
> postConf simpleUserHooks x configFlags' desc y
|
|
||||||
> where
|
|
||||||
> updateConfigFlags configFlags = configFlags
|
|
||||||
>
|
|
||||||
> postClean' _ _ _ _ = do
|
|
||||||
> try . removeFile $ "config.h"
|
|
||||||
> return ()
|
|
||||||
>
|
|
||||||
> checkHeimKinit :: IO String
|
|
||||||
> checkHeimKinit = do
|
|
||||||
> (e,_,_) <- readProcessWithExitCode "kinit" ["--version"] ""
|
|
||||||
> if e == ExitSuccess then
|
|
||||||
> return "#define HAVE_HEIMDAL 1"
|
|
||||||
> else return "/* #undef HAVE_HEIMDAL */"
|
|
||||||
@ -1,78 +0,0 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
#include "../../config.h"
|
|
||||||
-- | Module for using a kerberos authentication service.
|
|
||||||
--
|
|
||||||
-- 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 Web.Authenticate.Kerberos
|
|
||||||
( loginKerberos
|
|
||||||
, KerberosAuthResult(..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Text (Text)
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import Control.Monad (msum, guard)
|
|
||||||
import System.Process (readProcessWithExitCode)
|
|
||||||
import System.Timeout (timeout)
|
|
||||||
import System.Exit (ExitCode(..))
|
|
||||||
|
|
||||||
-- | Occurreable results of a Kerberos login
|
|
||||||
data KerberosAuthResult = Ok
|
|
||||||
| NoSuchUser
|
|
||||||
| WrongPassword
|
|
||||||
| TimeOut
|
|
||||||
| UnknownError Text
|
|
||||||
|
|
||||||
instance Show KerberosAuthResult where
|
|
||||||
show Ok = "Login sucessful"
|
|
||||||
show NoSuchUser = "Wrong username"
|
|
||||||
show WrongPassword = "Wrong password"
|
|
||||||
show TimeOut = "kinit respone timeout"
|
|
||||||
show (UnknownError msg) = "Unkown error: " ++ T.unpack msg
|
|
||||||
|
|
||||||
|
|
||||||
-- Given the errcode and stderr, return error-value
|
|
||||||
interpretError :: Int -> Text -> KerberosAuthResult
|
|
||||||
interpretError _ errmsg = fromJust . msum $
|
|
||||||
["Client not found in Kerberos database while getting" --> NoSuchUser,
|
|
||||||
"Preauthentication failed while getting" --> WrongPassword,
|
|
||||||
Just $ UnknownError errmsg]
|
|
||||||
where
|
|
||||||
substr --> kError = guard (substr `T.isInfixOf` errmsg) >> Just kError
|
|
||||||
|
|
||||||
-- | Given the username and password, try login to Kerberos service
|
|
||||||
loginKerberos :: Text -- ^ Username
|
|
||||||
-> Text -- ^ Password
|
|
||||||
-> IO KerberosAuthResult
|
|
||||||
loginKerberos username password = do
|
|
||||||
timedFetch <- timeout (10*1000000) fetch
|
|
||||||
case timedFetch of
|
|
||||||
Just res -> return res
|
|
||||||
Nothing -> return TimeOut
|
|
||||||
where
|
|
||||||
fetch :: IO KerberosAuthResult
|
|
||||||
fetch = do
|
|
||||||
(exitCode, _out, err) <- readProcessWithExitCode
|
|
||||||
#ifdef HAVE_HEIMDAL
|
|
||||||
"kinit" ["--password-file=STDIN", T.unpack username] (T.unpack password)
|
|
||||||
#else
|
|
||||||
"kinit" [T.unpack username] (T.unpack password)
|
|
||||||
#endif
|
|
||||||
case exitCode of
|
|
||||||
ExitSuccess -> return Ok
|
|
||||||
ExitFailure x -> return $ interpretError x (T.pack err)
|
|
||||||
|
|
||||||
@ -1,24 +0,0 @@
|
|||||||
name: authenticate-kerberos
|
|
||||||
version: 1.0.0
|
|
||||||
license: BSD3
|
|
||||||
license-file: LICENSE
|
|
||||||
author: Arash Rouhani
|
|
||||||
maintainer: Arash Rouhani
|
|
||||||
synopsis: Authentication methods for Haskell web applications.
|
|
||||||
description: Kerberos authenticate.
|
|
||||||
category: Web
|
|
||||||
stability: Stable
|
|
||||||
cabal-version: >= 1.6
|
|
||||||
build-type: Custom
|
|
||||||
homepage: http://github.com/yesodweb/authenticate
|
|
||||||
|
|
||||||
library
|
|
||||||
build-depends: base >= 4 && < 5
|
|
||||||
, text
|
|
||||||
, process
|
|
||||||
exposed-modules: Web.Authenticate.Kerberos
|
|
||||||
ghc-options: -Wall
|
|
||||||
|
|
||||||
source-repository head
|
|
||||||
type: git
|
|
||||||
location: git://github.com/yesodweb/authenticate.git
|
|
||||||
Loading…
Reference in New Issue
Block a user