-
Notifications
You must be signed in to change notification settings - Fork 370
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Added Kerberos source file and added to modules
- Loading branch information
Showing
2 changed files
with
73 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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) | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters