Merge branch 'master' of github.com:yesodweb/authenticate

authenticate-kerberos/Setup.lhs

@@ -2,6 +2,42 @@
 
 > 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 = defaultMain
+> 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 */"

authenticate-kerberos/Web/Authenticate/Kerberos.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+#include "../../config.h"
 -- | Module for using a kerberos authentication service.
 --
 -- Please note that all configuration should have been done
@@ -65,7 +67,11 @@ loginKerberos username password = do
     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)

authenticate-kerberos/authenticate-kerberos.cabal

@@ -9,7 +9,7 @@ description:     Kerberos authenticate.
 category:        Web
 stability:       Stable
 cabal-version:   >= 1.6
-build-type:      Simple
+build-type:      Custom
 homepage:        http://github.com/yesodweb/authenticate
 
 library

authenticate/Web/Authenticate/OpenId.hs

@@ -12,6 +12,7 @@ import OpenId2.Normalization (normalize)
 import OpenId2.Discovery (discover, Discovery (..))
 import OpenId2.Types
 import Control.Monad (unless)
+import qualified Data.Text as T
 import Data.Text.Lazy.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import Data.Text.Lazy (toStrict)
@@ -41,7 +42,11 @@ getForwardUrl
 getForwardUrl openid' complete mrealm params manager = do
     let realm = fromMaybe complete mrealm
     disc <- normalize openid' >>= flip discover manager
-    let helper s q = return $ s `mappend` decodeUtf8 (toByteString $ renderQueryText True $ map (second Just) q)
+    let helper s q = return $ T.concat
+            [ s
+            , if "?" `T.isInfixOf` s then "&" else "?"
+            , decodeUtf8 (toByteString $ renderQueryText False $ map (second Just) q)
+            ]
     case disc of
         Discovery1 server mdelegate -> helper server
                 $ ("openid.mode", "checkid_setup")

authenticate/authenticate.cabal

@@ -1,5 +1,5 @@
 name:            authenticate
-version:         1.0.0
+version:         1.0.0.1
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman, Hiromi Ishii, Arash Rouhani