diff --git a/Web/Authenticate/Kerberos.hs b/Web/Authenticate/Kerberos.hs new file mode 100644 index 00000000..c2c4aa58 --- /dev/null +++ b/Web/Authenticate/Kerberos.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | 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 + "kinit" [T.unpack username] (T.unpack password) + case exitCode of + ExitSuccess -> return Ok + ExitFailure x -> return $ interpretError x (T.pack err) + diff --git a/authenticate.cabal b/authenticate.cabal index 8dfa684c..74289eb5 100644 --- a/authenticate.cabal +++ b/authenticate.cabal @@ -1,8 +1,8 @@ name: authenticate -version: 0.9.2.2 +version: 0.9.2.3 license: BSD3 license-file: LICENSE -author: Michael Snoyman, Hiromi Ishii +author: Michael Snoyman, Hiromi Ishii, Arash Rouhani maintainer: Michael Snoyman synopsis: Authentication methods for Haskell web applications. description: Focus is on third-party authentication methods, such as OpenID, @@ -35,13 +35,15 @@ library blaze-builder >= 0.2 && < 0.4, attoparsec >= 0.9 && < 0.10, tls >= 0.7 && < 0.8, - containers + containers, + process >= 1.0.1.1 && < 1.1 exposed-modules: Web.Authenticate.Rpxnow, Web.Authenticate.OpenId, Web.Authenticate.BrowserId, Web.Authenticate.OpenId.Providers, Web.Authenticate.OAuth, Web.Authenticate.Facebook + Web.Authenticate.Kerberos other-modules: Web.Authenticate.Internal, OpenId2.Discovery, OpenId2.Normalization,