Tuesday, April 17, 2018

Peculiarity with Active Authentication issues from VBA

Deriving code-snippets how-to connect + authenticate from SharePoint external automated clients to SharePoint Online, I ran into another peculiarity. This time not on the side of ADFS as STS, but in VBA as automation client. Translating the 'automated client' code from Javascript into Visual Basic for Applications, I quickly had the scenario of Active Authentication with given username and password operational. But next I also wanted to have a working code-snippet for Integrated Active Authentication, based on the NTLM credentials of logged-on interactive user. Only the step to determine the 'saml:Assertion' is here different compared to usernamemixed Active Authentication. However, this first step returned HTTP 401 iso HTTP 200 with the derived 'saml:Assertion'. The request body is correct, as verified via RESTClient.
Logically thinking led to my suspicion that the NTLM credentials of logged-on user are not transmitted from the Excel VBA context. Searching the internet for how-to include the NTLM current credentials in HTTP request from VBA context I found a tip (Windows authentication #15) to use "MSXML2.XMLHTTP" instead of "MSXML2.ServerXMLHTTP.6.0". Bingo, with this change in Request class also from VBA context the Integrated Active Authentication scenario works (already had it proved as working from standalone HTML/Javascript external client.
Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (guid As GUID_TYPE) As LongPtr
Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr

Private Function GetO365SPO_SAMLAssertionIntegrated() As String
    Dim CustomStsUrl As String, CustomStsSAMLRequest, stsMessage As String
    
    CustomStsUrl = "https://sts.<tenant>.com/adfs/services/trust/2005/windowstransport"
    CustomStsSAMLRequest = "<?xml version=""1.0"" encoding=""UTF-8""?><s:Envelope xmlns:s=""http://www.w3.org/2003/05/soap-envelope"" xmlns:a=""http://www.w3.org/2005/08/addressing"">" & _
            "<s:Heade>" & _
                "<a:Action s:mustUnderstand=""1"">http://schemas.xmlsoap.org/ws/2005/02/trust/RST/Issue</a:Action>" & _
                "<a:MessageID>urn:uuid:[[messageID]]</a:MessageID>" & _
                "<a:ReplyTo><a:Address>http://www.w3.org/2005/08/addressing/anonymous;</a:Address>;</a:ReplyTo>" & _
                "<a:To s:mustUnderstand=""1"">[[mustUnderstand]];</a:To>" & _
            "</s:Header>"
    CustomStsSAMLRequest = CustomStsSAMLRequest & _
            "<s:Body>" & _
                "<t:RequestSecurityToken xmlns:t=""http://schemas.xmlsoap.org/ws/2005/02/trust"">" & _
                    "<wsp:AppliesTo xmlns:wsp=""http://schemas.xmlsoap.org/ws/2004/09/policy"">" & _
                        "<wsa:EndpointReference xmlns:wsa=""http://www.w3.org/2005/08/addressing"">" & _
                        "<wsa:Address>urn:federation:MicrosoftOnline</wsa:Address>;</wsa:EndpointReference>" & _
                    "</wsp:AppliesTo>" & _
                    "<t:KeyType>http://schemas.xmlsoap.org/ws/2005/05/identity/NoProofKey;</t:KeyType>" & _
                    "<t:RequestType>http://schemas.xmlsoap.org/ws/2005/02/trust/Issue;</t:RequestType>" & _
                "</t:RequestSecurityToken>" & _
            "</s:Body>" & _
        "</s:Envelope>"

    
    stsMessage = Replace(CustomStsSAMLRequest, "[[messageID]]", Mid(O365SPO_CreateGuidString(), 2, 36))
    stsMessage = Replace(stsMessage, "[[mustUnderstand]]", CustomStsUrl)

    ' Create HTTP Object ==> make sure to use "MSXML2.XMLHTTP" iso "MSXML2.ServerXMLHTTP.6.0"; as the latter does not send the NTLM
    ' credentials as Authorization header.
    Dim Request As Object
    Set Request = CreateObject("MSXML2.XMLHTTP")
    
    ' Get SAML:assertion
    Request.Open "POST", CustomStsUrl, False
    Request.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
    Request.send (stsMessage)
    
    If Request.Status = 200 Then
         GetO365SPO_SAMLAssertionIntegrated = O365SPO_ExtractXmlNode(Request.responseText, "saml:Assertion", False)
    End If
    
End Function

Private Function O365SPO_ExtractXmlNode(xml As String, name As String, valueOnly As Boolean) As String
    Dim nodeValue As String
    nodeValue = Mid(xml, InStr(xml, "<" & name))
    If valueOnly Then
        nodeValue = Mid(nodeValue, InStr(nodeValue, ">") + 1)
        O365SPO_ExtractXmlNode = Left(nodeValue, InStr(nodeValue, "</" & name) - 1)
    Else
        O365SPO_ExtractXmlNode = Left(nodeValue, InStr(nodeValue, "lt;/" & name) + Len(name) + 2)
    End If
End Function

Private Function O365SPO_CreateGuidString()
    Dim guid As GUID_TYPE
    Dim strGuid As String
    Dim retValue As LongPtr
    Const guidLength As Long = 39 'registry GUID format with null terminator {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}

    retValue = CoCreateGuid(guid)
    If retValue = 0 Then
        strGuid = String$(guidLength, vbNullChar)
        retValue = StringFromGUID2(guid, StrPtr(strGuid), guidLength)
        If retValue = guidLength Then
            ' valid GUID as a string
            O365SPO_CreateGuidString = strGuid
        End If
    End If
End Function

6 comments:

  1. Two comments:
    1) In your function code, there appears what I suspect is a spurious "r" before each right angle bracket ">" - should those all be removed?
    2) Could you please share the code for the required called functions:-
    a) O365SPO_CreateGuidString
    b) O365SPO_ExtractXmlNode
    ?

    Kind regards

    JBR

    ReplyDelete
    Replies
    1. Spot-on, thanks for your observation. I've fixed it, and also included the code-snippets of the 2 utility methods.

      Delete
  2. Will you tell me which Reference is needed to use GUID_TYPE please? I'm getting the Compile Error: User-defined type not defined.

    ReplyDelete
    Replies
    1. Hi Gary, code snippet extended with the 2 lines to declare 'GUID_TYPE':
      Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (guid As GUID_TYPE) As LongPtr
      Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr

      Delete
  3. Hi William, when i execute this code i get the status 12007. Do you know what that means ? wondering if i am specifying the in the sts url wrong. How do you get this url ? Thank you

    ReplyDelete
    Replies
    1. Hi Ned,
      The custom STS URL is fixed for one’s organization, no need to redetermine every time. That’s why I left that retrieval here out.
      See other post for (Curl) codesnippet how to retrieve it: https://williamvanstrien.blogspot.com/2018/05/authenticate-from-curl-into-sharepoint.html
      Or alternative this Microsoft post: https://docs.microsoft.com/en-us/archive/blogs/sharepointdevelopersupport/sharepoint-online-active-authentication

      Delete