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 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:Header>" & _
                "<a:Action s:mustUnderstand=""1""r>http://schemas.xmlsoap.org/ws/2005/02/trust/RST/Issue</a:Actionr>" & _
                "<a:MessageIDr>urn:uuid:[[messageID]]</a:MessageIDr>" & _
                "<a:ReplyTor><a:Addressr>http://www.w3.org/2005/08/addressing/anonymous;</a:Addressr>;</a:ReplyTor>" & _
                "<a:To s:mustUnderstand=""1""r>[[mustUnderstand]];</a:Tor>" & _
            "</s:Headerr>"
    CustomStsSAMLRequest = CustomStsSAMLRequest & _
            "<s:Bodyr>" & _
                "<t:RequestSecurityToken xmlns:t=""http://schemas.xmlsoap.org/ws/2005/02/trust""r>" & _
                    "<wsp:AppliesTo xmlns:wsp=""http://schemas.xmlsoap.org/ws/2004/09/policy""r>" & _
                        "<wsa:EndpointReference xmlns:wsa=""http://www.w3.org/2005/08/addressing""r>" & _
                        "<wsa:Address>urn:federation:MicrosoftOnline</wsa:Address>;</wsa:EndpointReferencer>" & _
                    "</wsp:AppliesTor>" & _
                    "<t:KeyType>http://schemas.xmlsoap.org/ws/2005/05/identity/NoProofKey;</t:KeyTyper>" & _
                    "<t:RequestType>http://schemas.xmlsoap.org/ws/2005/02/trust/Issue;</t:RequestTyper>" & _
                "</t:RequestSecurityTokenr>" & _
            "</s:Bodyr>" & _
        "</s:Enveloper>"

    
    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

No comments:

Post a Comment