Permalink
Browse files

Added RPX support again, using stripped-down module.

Note: wget must be in the system path, as it is used to make the
http request.
  • Loading branch information...
1 parent 87e45c2 commit 3cf667613a4dfcb9d7bb74d96ae19ec75e55b989 @jgm committed Apr 1, 2011
Showing with 86 additions and 10 deletions.
  1. +66 −4 Network/Gitit/Authentication.hs
  2. +9 −1 Network/Gitit/Config.hs
  3. +3 −3 Network/Gitit/Rpxnow.hs
  4. +3 −0 Network/Gitit/Types.hs
  5. +3 −1 data/default.conf
  6. +2 −1 gitit.cabal
@@ -23,7 +23,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
module Network.Gitit.Authentication ( loginUserForm
, formAuthHandlers
- , httpAuthHandlers ) where
+ , httpAuthHandlers
+ , rpxAuthHandlers) where
import Network.Gitit.State
import Network.Gitit.Types
@@ -41,14 +42,16 @@ import System.Exit
import System.Log.Logger (logM, Priority(..))
import Data.Char (isAlphaNum, isAlpha, isAscii)
import Text.Pandoc.Shared (substitute)
-import Data.Maybe (isJust, fromJust )
+import Data.Maybe (isJust, fromJust, isNothing, fromMaybe)
import Network.URL (encString, exportURL, add_param, importURL)
import Network.BSD (getHostName)
import qualified Text.StringTemplate as T
-import Network.HTTP (urlEncodeVars)
+import Network.HTTP (urlEncodeVars, urlDecode, urlEncode)
import Codec.Binary.UTF8.String (encodeString)
import Data.ByteString.UTF8 (toString)
-import Network.Gitit.Rpxnow
+import Network.Gitit.Rpxnow as R
+import Control.Monad.Reader (runReaderT, ask)
+import qualified Network.URI as U
data ValidationType = Register
| ResetPassword
@@ -430,6 +433,65 @@ httpAuthHandlers =
, dir "_login" $ withData loginUserHTTP
, dir "_user" currentUser ]
+-- Login using RPX (see RPX development docs at https://rpxnow.com/docs)
+loginRPXUser :: RPars -- ^ The parameters passed by the RPX callback call (after authentication has taken place
+ -> Handler
+loginRPXUser params = do
+ cfg <- getConfig
+ refer <- liftM U.parseURI getReferer
+ liftIO $ logM "gitit.loginRPXUser" DEBUG $ "Referer:" ++ show refer ++ " params: " ++ show params
+ let mtoken = rToken params
+ if isNothing mtoken
+ then do -- Initial call from the user
+ if isNothing refer
+ then see $ fromMaybe "/" $ rDestination params
+ else do -- Redirect user to RPX login
+ let ref = fromJust refer
+ let url = ref {U.uriPath="/_login",U.uriQuery="?destination=" ++ (fromMaybe (U.uriPath ref) $ rDestination params)}
+ if null (rpxDomain cfg)
+ then error "rpx-domain is not set."
+ else do
+ let rpx = "https://" ++ rpxDomain cfg ++ ".rpxnow.com/openid/v2/signin?token_url=" ++ urlEncode (show url)
+ see rpx
+ else do -- We got an answer from RPX, this might also return an exception.
+ uid' :: Either String R.Identifier <- liftIO $
+ R.authenticate (rpxKey cfg) $ fromJust mtoken
+ uid <- case uid' of
+ Right u -> return u
+ Left err -> error err
+ liftIO $ logM "gitit.loginRPXUser" DEBUG $ "uid:" ++ show uid
+ -- We need to get an unique identifier for the user
+ -- The 'identifier' is always present but can be rather cryptic
+ -- The 'verifiedEmail' is also unique and is a more readable choice
+ -- so we use it if present.
+ let userId = R.userIdentifier uid
+ let email = prop "verifiedEmail" uid
+ key <- newSession (SessionData userId)
+ addCookie (sessionTimeout cfg) (mkCookie "sid" (show key))
+ user <- liftIO $ mkUser (fromMaybe userId email) (fromMaybe "" email) "none"
+ addUser userId user
+ see $ fromJust $ rDestination params
+ where
+ prop pname info = lookup pname $ R.userData info
+ see url = seeOther (encUrl url) $ toResponse noHtml
+
+-- The parameters passed by the RPX callback call.
+data RPars = RPars {rToken::Maybe String,rDestination::Maybe String} deriving Show
+
+instance FromData RPars where
+ fromData = do
+ let look' = liftM urlDecode . look
+ env <- ask
+ let vtoken = runReaderT (look "token") env
+ let vDestination = runReaderT (look' "destination") env
+ return RPars {rToken=vtoken,rDestination=vDestination}
+
+rpxAuthHandlers :: [Handler]
+rpxAuthHandlers =
+ [ dir "_logout" $ methodSP GET $ withData logoutUser
+ , dir "_login" $ withData loginRPXUser
+ , dir "_user" currentUser ]
+
-- | Returns username of logged in user or null string if nobody logged in.
currentUser :: Handler
currentUser = do
@@ -27,7 +27,7 @@ where
import Network.Gitit.Types
import Network.Gitit.Server (mimeTypes)
import Network.Gitit.Framework
-import Network.Gitit.Authentication (formAuthHandlers, httpAuthHandlers)
+import Network.Gitit.Authentication (formAuthHandlers, rpxAuthHandlers, httpAuthHandlers)
import Network.Gitit.Util (parsePageType, readFileUTF8)
import System.Log.Logger (logM, Priority(..))
import qualified Data.Map as M
@@ -89,6 +89,8 @@ extractConfig cp = do
cfUseRecaptcha <- get cp "DEFAULT" "use-recaptcha"
cfRecaptchaPublicKey <- get cp "DEFAULT" "recaptcha-public-key"
cfRecaptchaPrivateKey <- get cp "DEFAULT" "recaptcha-private-key"
+ cfRPXDomain <- get cp "DEFAULT" "rpx-domain"
+ cfRPXKey <- get cp "DEFAULT" "rpx-key"
cfCompressResponses <- get cp "DEFAULT" "compress-responses"
cfUseCache <- get cp "DEFAULT" "use-cache"
cfCacheDir <- get cp "DEFAULT" "cache-dir"
@@ -116,6 +118,8 @@ extractConfig cp = do
"darcs" -> Darcs
"mercurial" -> Mercurial
x -> error $ "Unknown repository type: " ++ x
+ when (authMethod == "rpx" && cfRPXDomain == "") $
+ liftIO $ logM "gitit" WARNING $ "rpx-domain is not set"
return $! Config{
repositoryPath = cfRepositoryPath
@@ -131,6 +135,7 @@ extractConfig cp = do
, withUser = case authMethod of
"form" -> withUserFromSession
"http" -> withUserFromHTTPAuth
+ "rpx" -> withUserFromSession
_ -> id
, requireAuthentication = case map toLower cfRequireAuthentication of
"none" -> Never
@@ -141,6 +146,7 @@ extractConfig cp = do
, authHandler = case authMethod of
"form" -> msum formAuthHandlers
"http" -> msum httpAuthHandlers
+ "rpx" -> msum rpxAuthHandlers
_ -> mzero
, userFile = cfUserFile
, sessionTimeout = readNumber "session-timeout" cfSessionTimeout * 60 -- convert minutes -> seconds
@@ -169,6 +175,8 @@ extractConfig cp = do
, useRecaptcha = cfUseRecaptcha
, recaptchaPublicKey = cfRecaptchaPublicKey
, recaptchaPrivateKey = cfRecaptchaPrivateKey
+ , rpxDomain = cfRPXDomain
+ , rpxKey = cfRPXKey
, compressResponses = cfCompressResponses
, useCache = cfUseCache
, cacheDir = cfCacheDir
@@ -12,7 +12,6 @@ import Data.Maybe (isJust, fromJust)
import System.Process
import System.Exit
import System.IO
-import Data.List (intercalate)
import Network.HTTP (urlEncodeVars)
-- | Make a post request with parameters to the URL and return a response.
@@ -33,9 +32,10 @@ wget url params = do
-- | Information received from Rpxnow after a valid login.
data Identifier = Identifier
- { identifier :: String
- , extraData :: [(String, String)]
+ { userIdentifier :: String
+ , userData :: [(String, String)]
}
+ deriving Show
-- | Attempt to log a user in.
authenticate :: Monad m
@@ -113,6 +113,9 @@ data Config = Config {
useRecaptcha :: Bool,
recaptchaPublicKey :: String,
recaptchaPrivateKey :: String,
+ -- | RPX domain and key
+ rpxDomain :: String,
+ rpxKey :: String,
-- | Should responses be compressed?
compressResponses :: Bool,
-- | Should responses be cached?
View
@@ -30,7 +30,9 @@ authentication-method: form
# suppressed). 'generic' means that gitit will assume that
# some form of authentication is in place that directly
# sets REMOTE_USER to the name of the authenticated user
-# (e.g. mod_auth_cas on apache).
+# (e.g. mod_auth_cas on apache). 'rpx' means that gitit
+# will attempt to log in through https://rpxnow.com.
+# This requires that 'rpx-domain' and 'rpx-key' be set below.
user-file: gitit-users
# specifies the path of the file containing user login information.
View
@@ -145,7 +145,8 @@ Executable gitit
hslogger >= 1 && < 1.2,
ConfigFile >= 1 && < 1.1,
feed >= 0.3.6 && < 0.4,
- xss-sanitize >= 0.2 && < 0.3
+ xss-sanitize >= 0.2 && < 0.3,
+ json >= 0.4 && < 0.5
if impl(ghc >= 6.10)
build-depends: base >= 4, syb
if flag(plugins)

0 comments on commit 3cf6676

Please sign in to comment.