'***************************************************************************
' CAS_Authenticator : A Class wrapper that encapsulates authentication via CAS
'*************************************************************************** Class CAS_Authenticator
'*********************************************************
'Private Global variables
'********************************************************* Private m_ErrorText
Private m_CASURL
Private m_netID
Private objXML
Private srvXmlHttp
Private proxyArgHash
Private m_pgtUrl
Private m_pgtId
Private m_Proxies
Private queryCollection Private Sub Class_Initialize()
Set proxyArgHash = Server.CreateObject("Scripting.Dictionary")
Set objXML = Server.CreateObject("Microsoft.XMLDOM") 'set async for XML Dom
objXML.async = False Set srvXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
Set queryCollection = Server.CreateObject("Scripting.Dictionary")
End Sub Private Sub Class_Terminate()
Set objXML = Nothing
Set srvXMLHttp = Nothing
Set proxyArgHash = Nothing
Set queryCollection = Nothing
End Sub Public Sub AddProxyArgument(ByVal name, ByVal value)
If Not proxyArgHash.Exists(name) Then
proxyArgHash.Add name,value
EndIf
End Sub Public Property Get ProxyGrantingTicketIOU
ProxyGrantingTicketIOU = Application("pgtIou")
End Property Public Property Get Proxies
Proxies = m_Proxies
End Property Public Property Get netID
netID = m_netID
End Property Public Property Get LastError
LastError = m_ErrorText
End Property Public Property Let CASpgtUrl(ByVal vNewValue)
m_pgtUrl = vNewValue
End Property Public Property Let CASURL(ByVal vNewValue)
m_CASURL = vNewValue
End Property Public Sub LogOut(ByVal url)
Session.Abandon()
Response.Redirect m_CASURL & "/logout?url=" & url
End Sub Public Function MakeWebRequest(ByVal requestUrl, ByVal httpMethod)
OnError Resume Next
Err.Clear Select Case httpMethod
Case "GET"
'request method is a GET
'Check the proxy arguments
If proxyArgHash.Count > 0 Then
requestUrl = requestUrl & "?" & CollectionToQueryString(proxyArgHash)
End If
srvXmlHttp.open"GET", requestUrl, false
srvXmlHttp.send() Case "POST"
'request method is a POST
srvXmlHttp.open"POST", requestUrl, false
srvXmlHttp.setRequestHeader"Content-Type", "application/x-www-form-urlencoded" 'Check the proxy arguments
If proxyArgHash.Count > 0 Then
srvXmlHttp.send CollectionToQueryString(proxyArgHash)
Else
srvXmlHttp.send()
End If Case Else
'Return error
m_ErrorText = "Expecting either 'GET' OR 'POST' http method!"
MakeWebRequest = Empty
Exit Function End Select If Err <> 0 Then
m_ErrorText = Err.Description
MakeWebRequest = Empty
Exit Function
End If If srvXmlHttp.Status <> 200 Then
m_ErrorText = srvXmlHttp.Status & "- " & srvXmlHttp.StatusText
MakeWebRequest = Empty
Exit Function
End If MakeWebRequest = srvXmlHttp.responseText
End Function Private Function CollectionToQueryString(ByVal srcCollection)
Dim srcKey
Dim strCollItems Set strCollItems = New clsString
For Each srcKey insrcCollection.Keys
strCollItems.Add srcKey & "=" & srcCollection.Item(srcKey)
Next CollectionToQueryString = Mid(strCollItems.Delim("&"), 2)
Set strCollItems = Nothing
End Function Private Function CASRequest(ByValvalidateurl)
Dim proxyNodeText
Dim objCASResponse
Dim objCASAuthenticationNode
Dim objCASUser
Dim objCASProxies
Dim objCASpgt
Dim objCASProxy
Dim objCASproxyTicket
Dim objProxyList
Dim htmlResponse
Dim i validateUrl = validateUrl & "?" & CollectionToQueryString(queryCollection) htmlResponse = MakeWebRequest(validateUrl, "GET") If IsEmpty(htmlResponse) Then
CASRequest = False
Exit Function
End If If objXML.LoadXml(htmlResponse) Then 'Get reference to cas:serviceResponse XML Node
Set objCASResponse = objXML.getElementsByTagName("cas:serviceResponse")
If objCASResponse.length = 0 then
m_ErrorText = "cas:serviceResponse XML Node is Empty!"
CASRequest = False
Exit Function
End If Set objCASAuthenticationNode = objCASResponse.item(0).firstChild
Select Case objCASAuthenticationNode.nodeName
Case "cas:authenticationSuccess" 'Get CAS user nodeText
Set objCASUser = objCASAuthenticationNode.getElementsByTagName("cas:user")
If objCASUser.length = 0 then
m_ErrorText = "cas:user element NOT present in source CAS XML!"
CASRequest = False
Exit Function
End If m_netID = objCASUser.item(0).nodeTypedValue 'Get CAS proxies nodeText
Set objCASProxy = objCASAuthenticationNode.getElementsByTagName("cas:proxies")
If objCASProxy.length > 0 then
Set objProxyList = New clsString
Set objCASProxies = objCASProxy.item(0).childNodes For i = 0 To objCASProxies.length - 1
objProxyList.Add(objCASProxies.item | No Format |
|---|
(i) .nodeTypedValue)
Next
m_Proxies = objProxyList.Delim(vbcrlf)
Set objProxyList = Nothing
End If 'Get CAS proxyGT nodeText
Set objCASpgt = objCASAuthenticationNode.getElementsByTagName("cas:proxyGrantingTicket")
If objCASpgt.length > 0 Then
Application.Lock
Application("pgtIou") = objCASpgt.item(0).nodeTypedValue
Application.UnLock
End If Case "cas:authenticationFailure"
m_ErrorText = objCASAuthenticationNode.nodeTypedValue
CASRequest = False
Exit Function Case "cas:proxySuccess"
'Sample success returned from CAS
'<cas:proxySuccess xmlns:cas="http://www.yale.edu/tp/cas">
' <cas:proxyTicket>
' ST-1625-6YBqesAL6ywgfCwOPQYcK72G6ikQIHc6lab-aws-p1
' </cas:proxyTicket>
'</cas:proxySuccess> Set objCASproxyTicket = objCASAuthenticationNode.getElementsByTagName("cas:proxyTicket")
If objCASproxyTicket.length > 0 Then
m_pgtId = objCASproxyTicket.item(0).nodeTypedValue
End If Case "cas:proxyFailure"
'Sample error returned from CAS
'<cas:serviceResponse xmlns:cas="http://www.yale.edu/tp/cas">
' <cas:proxyFailure code="INVALID_TICKET">
' ticket 'TGT-3053-jqon6B5AIUQ4A6Pb2RlgykerJ99PhUrF0ON-aws-p1' not recognized
' </cas:proxyFailure>
'</cas:serviceResponse> m_ErrorText = objCASAuthenticationNode.nodeTypedValue
CASRequest = False
Exit Function Case Else
m_ErrorText = "Undefined CAS error!"
CASRequest = False
Exit Function
End Select
Else
m_ErrorText = "XML Failed to load<XMP>" & htmlResponse & "</XMP>"
CASRequest = False
Exit Function
End If 'CAS is Authenticated
CASRequest = True
End Function Public Function ServiceValidate(ByVal serviceUrl)
Dim tkt
Dim URLToValidate tkt = Request.QueryString.Item("ticket")
URLToValidate = m_CASURL & "/serviceValidate" If IsEmpty(tkt) Then
'if no ticket in URL then send user to CAS to get one
Response.Redirect(m_CASURL & "/login?service=" & serviceUrl)
ServiceValidate = True
Exit Function
End If ' Second time (back from CAS) there is a ticket= to validate
queryCollection.RemoveAll
queryCollection.Add "ticket", tkt
queryCollection.Add "service", serviceUrl If NOT IsEmpty(m_pgtUrl) Then
queryCollection.Add "pgtUrl", m_pgtUrl
EndIf If NOT CASRequest(URLToValidate) Then
ServiceValidate = False
Exit Function
EndIf ' If there was a problem, leave the message on the screen. Otherwise, return to original page.
If IsEmpty(netID) Then
m_ErrorText = "CAS returned to this application, but then refused to validate your identity."
ServiceValidate = False
Exit Function
End If ServiceValidate = True
End Function Public Function RequestProxyTicket(ByVal pgtId, ByVal proxyAppUrl)
Dim validateurl
validateurl = m_CASURL & "/proxy"
queryCollection.RemoveAll
queryCollection.Add "targetService", proxyAppUrl
queryCollection.Add "pgt", pgtId If Not CASRequest(validateurl) Then
RequestProxyTicket = Empty
Exit Function
End If RequestProxyTicket = m_pgtId
End Function Public Sub ValidateProxy(ByVal proxyTicket)
Dim validateurl ' Validate proxy ticket
validateurl = m_CASURL & "/proxyValidate" queryCollection.RemoveAll
queryCollection.Add "ticket", proxyTicket
queryCollection.Add "service", GetRequestUrl() If Not CASRequest(validateurl) Then
Exit Sub
End If ' If there was a problem, leave the message on the screen. Otherwise, return to original page.
If IsEmpty(m_netID) Then
m_ErrorText = "CAS returned to this application, but then refused to validate your identity."
Exit Sub
End If
End Sub End Class
|