Skip to main content

Tracking Permission Changes to Mailbox rights and Send As – Receive As ACE’s in Exchange

First up this script is not designed to audit who is making changes to permissions in Exchange. Tracking who is making changes to Active Directory objects in a distributed Network with multiple DC’s is not an easy thing to do my advice is if you need to do this hit the Google trail or look at third party products.

What this script does is give visibility of permission changes to users mailboxes/accounts made via ADUC via Exchange Mailbox Rights and Send-As/Receive as rights on the user object. It basically works by creating an XML file that is a snapshot of the current explicitly added rights on an Exchange Mailbox and any ACE’s that grant the extended rights for send and receive as. The next time the script runs it takes another snapshot of the rights and then using a couple of Scripting Dictionary object s does a comparison and finds Add ,Deletes or Permission changes and then produces a HTML report of these changes. To extend the usefulness of this script I’ve created a version that creates a WMI watcher on any ds_user modification events on a Domain controller. When a modification is detected it uses the IADstools to check the metadata in the directory to see if any of the security attributes have been modified recently an if so then does a snapshot compare to see if picks up any ACE’s changes. Any ACE changes that are found are then emailed to an emailaddress as a Htmlreport. This starts to get close to real-time reporting of changes. Now in a large network maybe you don’t want to be doing this because of the number of ds_user modification events you might receive could possible have a detrimental performance effect on the DC is question (eg don’t know really haven’t tested it)

The script itself is split up into a few different sections the first section does file management. To maintain an audit path every snap that is taken is stored so when the script has been run more then 2 times the 1st snap that is taken is then copied to an archive directory. The second section of the script handles opening, searching and comparing the different snapshots that are taken. I’ve used the Microsoft Dom object to do this although not the easiest thing in the world to use it is good for this type of data retrieval. The last section of the script is dedicated to writing the snapshot because the format of the xml was pretty simple I’ve just used the FSO item to write the XML manually.

To use the script you should first check the following 4 variables and make sure the directories that variable refers to exists.

csCurrentSnapFileName = "c:\temp\currentSnap.xml"
psPreviousSnapFileName = "c:\temp\prevSnap.xml"
adArchieveDirectory = "c:\temp\SnapArchive\"
rfReportFileName = "c:\temp\ACLChangeReport-"

I’ve created two versions of the script the first is a simple version that is designed to be run from a scheduler and just looks for changes against the last snap every time its run and then writes a HTML report to the configured directory if any changes are detected. The second version is WMI watcher script that watches for changes to the ds_user class on the server and then emails a configured address with a report of any changes.
For this version of the script there are three variables that need to be configured first for email functionality section.

SenderAddress = "sender@domain.com"
RecieverAddress = "reciever@domain.com"
EmailServername = “servername”

The script itself takes one commandline parameter which is the netbios name of the DC you want to run it against. The WMI version also requires that you have the Windows 2000/3 Support Tools installed so you will have the iadstools.dll registered. The other things to be aware of is there a 15 minute change detection period depending on the replication latency in your network you may need to make this greater.

If DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now()) < 15 Then fsnap = 1

I’ve put a downloadable copy of the script here the wmi version of the script looks like

Const RIGHT_DS_DELETE = &H10000
Const RIGHT_DS_READ = &H20000
Const RIGHT_DS_CHANGE = &H40000
Const RIGHT_DS_TAKE_OWNERSHIP = &H80000
Const RIGHT_DS_MAILBOX_OWNER = &H1
Const RIGHT_DS_SEND_AS = &H2
Const RIGHT_DS_PRIMARY_OWNER = &H4

csCurrentSnapFileName = "c:\temp\currentSnap.xml"
psPreviousSnapFileName = "c:\temp\prevSnap.xml"
adArchieveDirectory = "c:\temp\SnapArchive\"
rfReportFileName = "c:\temp\ACLChangeReport-"

SenderAddress = "sender@domain.com"
RecieverAddress = "receiver@domain.com"
EmailServername = "mailserver"

strComputer = wscript.arguments(0)

Set fso = CreateObject("Scripting.FileSystemObject")
set objIadsTools = CreateObject("IADsTools.DCFunctions")
Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/directory/LDAP")
strWQL = "SELECT * " & _
"FROM __InstanceModificationEvent " & _
"WITHIN 2 " & _
"WHERE TargetInstance ISA 'ds_user'"
WScript.Echo "Waiting User Modifications"
Set objEventSource = objWMIService.ExecNotificationQuery(strWQL)
Do
Set objEventObject = objEventSource.NextEvent()
WScript.Echo "User Modified : " & objEventObject.TargetInstance.DS_displayName
Call getUserData(strComputer,objEventObject.TargetInstance.DS_distinguishedName)
Loop

sub getUserData(dcDomainController,dnUserDN)
fsnap = 0
intRes = objIadsTools.GetMetaData(Cstr(dcDomainController),Cstr(dnUserDN),0)
if intRes = -1 then
Wscript.Echo objIadsTools.LastErrorText
WScript.Quit
end if
wscript.echo "User" & dnUserDN
wscript.echo Now()
for count = 1 to intRes
Select Case objIadsTools.MetaDataName(count)
Case "nTSecurityDescriptor" wscript.echo "nTSecurityDescriptor LastModified : "
& objIadsTools.MetaDataLastWriteTime(count)_
& " Time Diff : " &
DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now())
If DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now()) <
15 Then fsnap = 1
Case "msExchMailboxSecurityDescriptor" wscript.echo "msExchMailboxSecurityDescriptor
Last Modified : " _
& objIadsTools.MetaDataLastWriteTime(count) & " Time Diff : " &
DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now())
If DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now()) <
15 Then fsnap = 1
End Select
Next
If fsnap = 1 Then CheckACLs

end Sub

Sub CheckACLs()

rrRightReport = 0
If fso.FileExists(csCurrentSnapFileName) Then
wscript.echo "Snap Exists"
If fso.FileExists(psPreviousSnapFileName) Then
fso.deletefile(psPreviousSnapFileName)
fso.movefile csCurrentSnapFileName, psPreviousSnapFileName
set xdXmlDocument = CreateObject("Microsoft.XMLDOM")
xdXmlDocument.async="false"
xdXmlDocument.load(psPreviousSnapFileName)
Set xnSnaptime = xdXmlDocument.selectNodes("//SnappedACLS")
For Each exSnap In xnSnaptime
oldSnap = exSnap.attributes.getNamedItem("SnapDate").nodeValue
wscript.echo "Snap Taken : " & oldSnap
takesnap
afFileName = adArchieveDirectory &
Replace(Replace(Replace(exSnap.attributes.getNamedItem("SnapDate").nodeValue,":",""),",",""),"
","") & ".xml"
wscript.echo "Archiving Old Snap to : " & afFileName
fso.copyfile psPreviousSnapFileName, afFileName
Next
set xdXmlDocument1 = CreateObject("Microsoft.XMLDOM")
xdXmlDocument1.async="false"
xdXmlDocument1.load(csCurrentSnapFileName)
Set ckCurrentPerms = CreateObject("Scripting.Dictionary")
Set pkPreviousPerms = CreateObject("Scripting.Dictionary")
Set xnCurrentPermsUsers = xdXmlDocument1.selectNodes("//User")
For Each xnUserNode In xnCurrentPermsUsers
unUserName = xnUserNode.attributes.getNamedItem("SamaccountName").nodeValue
For Each caACLs In xnUserNode.ChildNodes
ckCurrentACL = unUserName & "|-|" &
caACLs.attributes.getNamedItem("User").nodeValue
ckCurrentPerms.add ckCurrentACL,
caACLs.attributes.getNamedItem("Right").nodeValue
Next
Next
Set xnPrevPermsUsers = xdXmlDocument.selectNodes("//User")
For Each xnUserNode1 In xnPrevPermsUsers
unUserName1 = xnUserNode1.attributes.getNamedItem("SamaccountName").nodeValue
For Each caACLs1 In xnUserNode1.ChildNodes
pkPrevACL = unUserName1 & "|-|" &
caACLs1.attributes.getNamedItem("User").nodeValue
pkPreviousPerms.add pkPrevACL,
caACLs1.attributes.getNamedItem("Right").nodeValue
rem Do a Check for Any Deleted or Changed Permisssions
If ckCurrentPerms.exists(pkPrevACL) Then
If ckCurrentPerms(pkPrevACL) <>
caACLs1.attributes.getNamedItem("Right").nodeValue Then
rrRightReport = 1
wscript.echo "Found Changed ACL "
wscript.echo "Old Rights : " & pkPrevACL & " " &
caACLs1.attributes.getNamedItem("Right").nodeValue
wscript.echo "New Rights : " & pkPrevACL & " " & ckCurrentPerms(pkPrevACL)
hrmodHtmlReport = hrmodHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & unUserName1 & " </font></td>" & vbcrlf
hrmodHtmlReport = hrmodHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">Old Rights: " & caACLs1.attributes.getNamedItem("User").nodeValue _
& " " & caACLs1.attributes.getNamedItem("Right").nodeValue & " </font></td>" &
vbcrlf
hrmodHtmlReport = hrmodHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">New Rights: " _
& caACLs1.attributes.getNamedItem("User").nodeValue & " " &
ckCurrentPerms(pkPrevACL) & " </font></td></tr>" & vbcrlf
End if
Else
rrRightReport = 1
hrDelHtmlReport = hrDelHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & unUserName1 & " </font></td>" & vbcrlf
hrDelHtmlReport = hrDelHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">" & caACLs1.attributes.getNamedItem("User").nodeValue _
& " " & caACLs1.attributes.getNamedItem("Right").nodeValue & "
</font></td></tr>" & vbcrlf
Wscript.echo "Found Deleted ACL : " & pkPrevACL & " " &
caACLs1.attributes.getNamedItem("Right").nodeValue
End if
Next
Next
rem Do forward check of ACL's
For Each dkCurrenPermKey In ckCurrentPerms.keys
If Not pkPreviousPerms.exists(dkCurrenPermKey) Then
rrRightReport = 1
dknewpermarry = Split(dkCurrenPermKey,"|-|")
hrnewHtmlReport = hrnewHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & dknewpermarry(0) & " </font></td>" & vbcrlf
hrnewHtmlReport = hrnewHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">" & dknewpermarry(1) _
& " " & ckCurrentPerms(dkCurrenPermKey) & " </font></td></tr>" & vbcrlf
Wscript.echo "Found new ACL : " & dkCurrenPermKey & " " &
ckCurrentPerms(dkCurrenPermKey)
End if
next
Else
wscript.echo "No current permissions snap exists taking snap"
Call TakeSnap
End If
If rrRightReport = 1 Then
wscript.echo "Writing Report"
hrHtmlReport = "<html><body>" & vbcrlf
NewSnapDate = WeekdayName(weekday(now),3) & ", " & day(now()) & " " &
Monthname(month(now()),3) & " " & year(now()) & " " & formatdatetime(now(),4) &
":00"
hrHtmlReport = hrHtmlReport & "<p><font size=""4"" face=""Arial Black""
color=""#008000"">Change To Mailbox Rights Report for Snaps Taken Between -
</font>" & oldSnap & " and "_
& NewSnapDate & "</font></p>" & vbcrlf
If hrnewHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">ACL's Added</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport &
Replace(Replace(hrnewHtmlReport,"-exra-",""),"-exsa-","") & "</table>"
End If
If hrmodHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">ACL's Modified</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport &
Replace(Replace(hrmodHtmlReport,"-exra-",""),"-exsa-","") & "</table>"
End If
If hrDelHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">ACL's Deleted</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport &
Replace(Replace(hrDelHtmlReport,"-exra-",""),"-exsa-","") & "</table>"
End If
hrHtmlReport = hrHtmlReport & "</body></html>" & vbcrlf
Set objEmail = CreateObject("CDO.Message")
objEmail.From = SenderAddress
objEmail.To = RecieverAddress
objEmail.Subject = "ACL Change Report"
objEmail.htmlbody = hrHtmlReport
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")
= 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
= EmailServername
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
objEmail.Configuration.Fields.Update
objEmail.Send
wscript.echo "Email Sent"
End If

End Sub

Sub TakeSnap

set wfile = fso.opentextfile(csCurrentSnapFileName,2,true)
wfile.writeline("<?xml version=""1.0""?>")
wfile.writeline("<SnappedACLS SnapDate=""" & WeekdayName(weekday(now),3) & ", "
& day(now()) & " " & Monthname(month(now()),3) & " " & year(now()) & " " &
formatdatetime(now(),4) & ":00" & """>")

Set objSystemInfo = CreateObject("ADSystemInfo")
strdname = objSystemInfo.DomainShortName
set conn1 = createobject("ADODB.Connection")
strConnString = "Data Provider=NONE; Provider=MSDataShape"
conn1.Open strConnString
set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
Query = "<LDAP://" & strNameingContext & ">;(&(&(& (mailnickname=*) (|
(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*)))
))));samaccountname,displayname,distinguishedName;subtree"
Com.ActiveConnection = Conn
Com.CommandText = Query
Com.Properties("Page Size") = 1000
Set Rs = Com.Execute
While Not Rs.EOF
dn = "LDAP://" & replace(rs.Fields("distinguishedName").Value,"/","\/")
set objuser = getobject(dn)
Set oSecurityDescriptor = objuser.Get("msExchMailboxSecurityDescriptor")
Set oUserSecurityDescriptor = objuser.Get("ntSecurityDescriptor")
Set oUserdacl = oUserSecurityDescriptor.DiscretionaryAcl
Set oUserace = CreateObject("AccessControlEntry")
Set dacl = oSecurityDescriptor.DiscretionaryAcl
Set ace = CreateObject("AccessControlEntry")
fwFirstWrite = 0
For Each ace In dacl
if ace.AceFlags <> 18 then
if ace.Trustee <> "NT AUTHORITY\SELF" Then
If fwFirstWrite = 0 Then
wfile.writeline(" <User SamaccountName=""" & rs.fields("samaccountname") &
""">")
fwFirstWrite = 1
End if
wfile.writeline("<ACE User=""" & ace.Trustee & """ Right=""" &
getRights(ace.AccessMask) & """></ACE>")
end if
end if
Next
For Each oUserace In oUserdacl
if lcase(oUserace.ObjectType) = "{ab721a54-1e2f-11d0-9819-00aa0040529b}" and
oUserace.AceType = 5 Then
if oUserace.Trustee <> "NT AUTHORITY\SELF" and oUserace.AceFlags <> 6 Then
if fwFirstWrite = 0 Then
wfile.writeline(" <User SamaccountName=""" & rs.fields("samaccountname") &
""">")
fwFirstWrite = 1
End If
wfile.writeline("<ACE User=""" & oUserace.Trustee & "-exsa-" & """ Right=""Send
As""></ACE>")
end if
end if
if lcase(oUserace.ObjectType) = "{ab721a56-1e2f-11d0-9819-00aa0040529b}" and
oUserace.AceType = 5 Then
if oUserace.Trustee <> "NT AUTHORITY\SELF" and oUserace.AceFlags <> 6 then
If fwFirstWrite = 0 Then
wfile.writeline(" <User SamaccountName=""" & rs.fields("samaccountname") &
""">")
fwFirstWrite = 1
End If
wfile.writeline("<ACE User=""" & oUserace.Trustee & "-exra-" & """
Right=""Recieve As""></ACE>")
end if
end if
Next

If fwFirstWrite = 1 then
wfile.writeline("</User>")
End if
rs.movenext
Wend
wfile.writeline("</SnappedACLS>")
wscript.echo "New Snap Taken"

End Sub

Function getRights(hvHexValue)
If (hvHexValue And RIGHT_DS_SEND_AS) Then
getRights = "Send As"
End If
If (hvHexValue And RIGHT_DS_CHANGE) Then
getRights = "Modify user attributes"
End If
If (hvHexValue And RIGHT_DS_DELETE) Then
getRights = "Delete mailbox store"
End If
If (hvHexValue And RIGHT_DS_READ) Then
getRights = "Read permissions"
End If
If (hvHexValue And RIGHT_DS_TAKE_OWNERSHIP) Then
getRights = "Take Ownership"
End If
If (hvHexValue And RIGHT_DS_MAILBOX_OWNER) Then
getRights = "Mailbox Owner"
End If
If (hvHexValue And RIGHT_DS_PRIMARY_OWNER) Then
getRights = "Mailbox Primary Owner"
End If
End Function

Function reformatdate(dtDatetoTransform)
dtarry = split(dtDatetoTransform,"/")
tmArry = split(dtarry(2)," ")
rdReturnDate = formatdatetime(dateserial(tmArry(0),dtarry(0),dtarry(1)) & " " &
tmArry(1) & " " & tmArry(2))
reformatdate = rdReturnDate
End function

Popular posts from this blog

Testing and Sending email via SMTP using Opportunistic TLS and oAuth in Office365 with PowerShell

As well as EWS and Remote PowerShell (RPS) other mail protocols POP3, IMAP and SMTP have had OAuth authentication enabled in Exchange Online (Official announcement here ). A while ago I created  this script that used Opportunistic TLS to perform a Telnet style test against a SMTP server using SMTP AUTH. Now that oAuth authentication has been enabled in office365 I've updated this script to be able to use oAuth instead of SMTP Auth to test against Office365. I've also included a function to actually send a Message. Token Acquisition  To Send a Mail using oAuth you first need to get an Access token from Azure AD there are plenty of ways of doing this in PowerShell. You could use a library like MSAL or ADAL (just google your favoured method) or use a library less approach which I've included with this script . Whatever way you do this you need to make sure that your application registration  https://docs.microsoft.com/en-us/azure/active-directory/develop/quickstart-register-

How to test SMTP using Opportunistic TLS with Powershell and grab the public certificate a SMTP server is using

Most email services these day employ Opportunistic TLS when trying to send Messages which means that wherever possible the Messages will be encrypted rather then the plain text legacy of SMTP.  This method was defined in RFC 3207 "SMTP Service Extension for Secure SMTP over Transport Layer Security" and  there's a quite a good explanation of Opportunistic TLS on Wikipedia  https://en.wikipedia.org/wiki/Opportunistic_TLS .  This is used for both Server to Server (eg MTA to MTA) and Client to server (Eg a Message client like Outlook which acts as a MSA) the later being generally Authenticated. Basically it allows you to have a normal plain text SMTP conversation that is then upgraded to TLS using the STARTTLS verb. Not all servers will support this verb so if its not supported then a message is just sent as Plain text. TLS relies on PKI certificates and the administrative issue s that come around certificate management like expired certificates which is why I wrote th

The MailboxConcurrency limit and using Batching in the Microsoft Graph API

If your getting an error such as Application is over its MailboxConcurrency limit while using the Microsoft Graph API this post may help you understand why. Background   The Mailbox  concurrency limit when your using the Graph API is 4 as per https://docs.microsoft.com/en-us/graph/throttling#outlook-service-limits . This is evaluated for each app ID and mailbox combination so this means you can have different apps running under the same credentials and the poor behavior of one won't cause the other to be throttled. If you compared that to EWS you could have up to 27 concurrent connections but they are shared across all apps on a first come first served basis. Batching Batching in the Graph API is a way of combining multiple requests into a single HTTP request. Batching in the Exchange Mail API's EWS and MAPI has been around for a long time and its common, for email Apps to process large numbers of smaller items for a variety of reasons.  Batching in the Graph is limited to a m
All sample scripts and source code is provided by for illustrative purposes only. All examples are untested in different environments and therefore, I cannot guarantee or imply reliability, serviceability, or function of these programs.

All code contained herein is provided to you "AS IS" without any warranties of any kind. The implied warranties of non-infringement, merchantability and fitness for a particular purpose are expressly disclaimed.