authenticate-kerberos (empty) → 1.0.0

raw patch · 4 files changed

+128/−0 lines, 4 filesdep +basedep +processdep +textsetup-changed

Dependencies added: base, process, text

Files

• LICENSE +25/−0
• Setup.lhs +7/−0
• Web/Authenticate/Kerberos.hs +72/−0
• authenticate-kerberos.cabal +24/−0

@@ -0,0 +1,25 @@+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.

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

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

@@ -0,0 +1,24 @@+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:      Simple+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