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