23.5 Listing ACEs to a File for All Objects in an OU and Below

A good example of a useful real-world task is when you are curious to see what ACEs have been set on all objects below a container, such as a domain or Organizational Unit. Example 23-4 is a piece of code that can be used as the basis for checking through an Active Directory forest looking for irregularities.

This code also could be used on the root of Active Directory when dealing with the problem outlined in Section 11.3.3 in Chapter 11. The code is fairly simple but very long, due to the fact that it has to check every constant for both the SACL and DACL of each object.

Example 23-4. Examining the ACEs on all objects below a container

On Error Resume Next
   
'****************************************************************************
'If the GUID corresponds to a schema object or attribute, then print the 
'schema attribute/object name and the GUID. Otherwise just print the GUID.
'****************************************************************************
Sub PrintGUID(ByVal objType)
   
  Dim strACEGUID, bolFound, intIndex
   
  '****************************************************************************
  'Convert a GUID that starts and ends with {  } and has dashes within to a
  'simple string of text
  '****************************************************************************
  strACEGUID = Replace(Mid(objType,2,Len(objType)-2),"-","")
   
  '****************************************************************************
  'Scan the array of schema values for a matching GUID (after converting both
  'GUIDs to uppercase first). If a GUID is found, the name is printed.
  '****************************************************************************
  ts.WriteLine vbTab & vbTab & "GUID: " & objType
  For intIndex=0 To UBound(arrSchema,2)
    If (UCase(strACEGUID) = UCase(arrSchema(0,intIndex))) Then
      ts.WriteLine vbTab & vbTab & "Name: " & arrSchema(1,intIndex)
    End If
  Next
End Sub
   
'****************************************************************************
'This function checks to see if the first integer value contains the constant
'passed in as the second integer value. If it does, then the third parameter
'is written out to the file, and the first value is decremented by the amount
'of the constant.
'****************************************************************************
Sub CheckValue(ByRef lngValueToCheck, ByVal lngConstant, ByVal strConstantName)
  If ((lngValueToCheck And lngConstant) = lngConstant) Then
    ts.WriteLine vbTab & strConstantName
    lngValueToCheck = lngValueToCheck Xor lngConstant
  Else
    lngValueToCheck = lngValueToCheck
  End If
End Sub
   
'**************************************************************************
'AccessMask constants
'**************************************************************************
Const ADS_RIGHT_GENERIC_READ = &H80000000
Const ADS_RIGHT_GENERIC_WRITE = &H40000000
Const ADS_RIGHT_GENERIC_EXECUTE = &H20000000
Const ADS_RIGHT_GENERIC_ALL = &H10000000
Const ADS_RIGHT_SYSTEM_SECURITY = &H1000000
Const ADS_RIGHT_SYNCHRONIZE = &H100000
Const ADS_RIGHT_WRITE_OWNER = &H80000
Const ADS_RIGHT_WRITE_DAC = &H40000
Const ADS_RIGHT_READ_CONTROL = &H20000
Const ADS_RIGHT_DELETE = &H10000
Const ADS_RIGHT_DS_CONTROL_ACCESS = &H100
Const ADS_RIGHT_DS_LIST_OBJECT = &H80
Const ADS_RIGHT_DS_DELETE_TREE = &H40
Const ADS_RIGHT_DS_WRITE_PROP = &H20
Const ADS_RIGHT_DS_READ_PROP = &H10
Const ADS_RIGHT_DS_SELF = &H8
Const ADS_RIGHT_ACTRL_DS_LIST = &H4
Const ADS_RIGHT_DS_DELETE_CHILD = &H2
Const ADS_RIGHT_DS_CREATE_CHILD = &H1
Const FULL_CONTROL = -1
   
'**************************************************************************
'AceType constants
'**************************************************************************
Const ADS_ACETYPE_SYSTEM_AUDIT_OBJECT = &H7
Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &H6
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5
Const ADS_ACETYPE_SYSTEM_AUDIT = &H2
Const ADS_ACETYPE_ACCESS_DENIED = &H1
Const ADS_ACETYPE_ACCESS_ALLOWED = &H0
   
'**************************************************************************
'AceFlags constants
'**************************************************************************
Const ADS_ACEFLAG_FAILED_ACCESS = &H80
Const ADS_ACEFLAG_SUCCESSFUL_ACCESS = &H40
Const ADS_ACEFLAG_VALID_INHERIT_FLAGS = &H1F
Const ADS_ACEFLAG_INHERITED_ACE = &H10
Const ADS_ACEFLAG_INHERIT_ONLY_ACE = &H8
Const ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE = &H4
Const ADS_ACEFLAG_INHERIT_ACE = &H2
   
'**************************************************************************
'Security Descriptor constants
'**************************************************************************
Const ADS_SD_CONTROL_SE_OWNER_DEFAULTED = &H1
Const ADS_SD_CONTROL_SE_GROUP_DEFAULTED = &H2
Const ADS_SD_CONTROL_SE_DACL_PRESENT = &H4
Const ADS_SD_CONTROL_SE_DACL_DEFAULTED = &H8
Const ADS_SD_CONTROL_SE_SACL_PRESENT = &H10
Const ADS_SD_CONTROL_SE_SACL_DEFAULTED = &H20
Const ADS_SD_CONTROL_SE_DACL_AUTO_INHERIT_REQ = &H100
Const ADS_SD_CONTROL_SE_SACL_AUTO_INHERIT_REQ = &H200
Const ADS_SD_CONTROL_SE_DACL_AUTO_INHERITED = &H400
Const ADS_SD_CONTROL_SE_SACL_AUTO_INHERITED = &H800
Const ADS_SD_CONTROL_SE_DACL_PROTECTED = &H1000
Const ADS_SD_CONTROL_SE_SACL_PROTECTED = &H2000
   
'**************************************************************************
'Flags constants
'**************************************************************************
Const ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT = &H2
Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H1
   
'****************************************************************************
'Two example paths. You need to specify your own path here in the constant or
'obtain it from an argument to the script or an InputBox.
'****************************************************************************
'Const LDAP_PATH = "LDAP://cn=Mike Felmeri,ou=Sales,dc=amer,dc=mycorp,dc=com"
'Const LDAP_PATH = "LDAP://dc=amer,dc=mycorp,dc=com"
Const SCHEMA_ROOT="LDAP://cn=Schema,cn=Configuration,dc=mycorp,dc=com"
   
' **********************************************************************
' Opens a file, and lets you start writing from the beginning of the
' file.
' **********************************************************************
Const ForWriting = 2
   
' **********************************************************************
' Sets the location of the temporary file
' **********************************************************************
Const TEMPFILE = "C:\SD-LIST-TEMP.TXT"
   
'****************************************************************************
'Declare the variables
'****************************************************************************
Dim objUser, objSecDesc, objSecDescControl, objACE, objDACL
Dim objSACL, objACEAccessMask, objACEAceType, objACEAceFlags 
Dim lngBeforeChange, intCount, fso, ts, strCriteria, objObject
Dim arrSchema(  ), objSchema, intIndex
   
'****************************************************************************
'Fill an array with GUIDs and CNs from all the objects in the schema. As we
'don't know the maximum number of elements in advance, the array is gradually
'redimensioned (i.e.,  has its size increased) each time we wish to add a new value.
'
'So, if there are 4,000 values in the schema, then the array will look like
'this:
'
'  arrSchema(0,0) = 1st schema object GUID
'  arrSchema(1,0) = 1st schema object cn
'  arrSchema(0,1) = 2nd schema object GUID
'  arrSchema(1,1) = 2nd schema object cn
'  arrSchema(0,2) = 3rd schema object GUID
'  arrSchema(1,2) = 3rd schema object cn
'    etc.
'  arrSchema(0,3999) = 4,000th schema object GUID
'  arrSchema(1,3999) = 4,000th schema object cn
'
'UBound(arrSchema,1) gives the max-size of the first dimension (i.e., 1)
'UBound(arrSchema,2) gives the max-size of the second dimension (i.e., 3999)
'****************************************************************************
Set objSchema = GetObject(SCHEMA_ROOT)
intIndex = 0
For Each objObject in objSchema
  'Increase the size of the array while preserving values
  ReDim Preserve arrSchema(1,intIndex)
  arrSchema(0,intIndex) = objObject.GUID
  'Set the name to be everything except the "cn=" on the front
  arrSchema(1,intIndex) = Right(objObject.cn, Len(objObject.Name)-3)
  intIndex = intIndex + 1
Next
   
'**********************************************************************
'Opens the temporary text file for writing. If the text file already 
'exists, overwrite it.
'**********************************************************************
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(TEMPFILE, ForWriting, True)
   
'****************************************************************************
'Get the security descriptor of the object
'****************************************************************************
Set objObject = GetObject(LDAP_PATH)
Set objSecDesc = objObject.Get("nTSecurityDescriptor")
   
'****************************************************************************
'Write out the SD general information
'****************************************************************************
ts.WriteLine "------------------------------------------------------------------"
ts.WriteLine "SD revision is: " & objSecDesc.Revision
ts.WriteLine "SD Owner is: " & objSecDesc.Owner
ts.WriteLine "SD Group is: " & objSecDesc.Group
ts.WriteLine "SD GroupDefaulted is: " & objSecDesc.GroupDefaulted
ts.WriteLine "SD OwnerDefaulted is: " & objSecDesc.OwnerDefaulted
ts.WriteLine "SD DaclDefaulted is: " & objSecDesc.DaclDefaulted
ts.WriteLine "SD SaclDefaulted is: " & objSecDesc.SaclDefaulted
ts.WriteLine "------------------------------------------------------------------"
   
'****************************************************************************
'Write out the SD control flags
'****************************************************************************
ts.WriteLine "SD Control is: "
objSecDescControl = objSecDesc.Control
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SELF_RELATIVE, _
  "The SD is held in a contiguous block of memory."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_PROTECTED, "The SACL of " _
  & "the SD is protected and will not be modified when new rights propagate " _
  & "through the tree."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_PROTECTED, "The DACL of " _
  & "the SD is protected and will not be modified when new rights propagate " _
  & "through the tree."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_AUTO_INHERITED, "The SACL" _
  & " of the SD supports auto-propagation of inheritable ACEs to existing " _
  & " child objects."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_AUTO_INHERITED, "The DACL" _
  & " of the SD supports auto-propagation of inheritable ACEs to existing " _
  & "child objects."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_AUTO_INHERIT_REQ, "The " _
  & "SACL of the SD must be inherited."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_AUTO_INHERIT_REQ, "The " _
  & "DACL of the SD must be inherited."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_DEFAULTED, "The ACL " _
  & "pointed to by the SystemAcl field was provided by the default mechanism " _
  & "rather than explicitly set by the person or application that created the " _
  & "SD in the first place."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_PRESENT, "The security " _
  & "descriptor contains a SACL."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_DEFAULTED, "The " _
  & "DiscretionaryAcl field was provided by the default mechanism rather than " _
  & "explicitly set by the person or application that created the SD in the " _
  & "first place."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_PRESENT, "The security " _
  & "descriptor contains a DACL."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_GROUP_DEFAULTED, "The SID in " _
  & "the Group field was provided by the default mechanism rather than " _
  & "explicitly set by the person or application that created the SD in the " _
  & "first place."
CheckValue objSecDescControl, ADS_SD_CONTROL_SE_OWNER_DEFAULTED, "The SID " _
  & "pointed to by the Owner field was provided by the default mechanism " _
  & "rather than set by the person or application that created the SD in the " _
  & "first place."
   
'****************************************************************************
'Write out the DACL general information
'****************************************************************************
Set objDACL = objSecDesc.DiscretionaryAcl   'Permissions List
   
ts.WriteLine "-----------------"
ts.WriteLine "-----------------"
ts.WriteLine "Discretionary ACL"
ts.WriteLine "-----------------"
ts.WriteLine "-----------------"
ts.WriteLine "There are " & objDACL.AceCount & " ACEs in the DACL."
ts.WriteLine "DACL revision is: " & objDACL.AclRevision
 
intCount = 1
For Each objACE In objDACL
  ts.WriteLine "----------------------------------------------------------------"
  ts.WriteLine "ACE Trustee " & intCount & " of " & objDACL.AceCount & " is: " _
    & objACE.Trustee
   
  '****************************************************************************
  'Write out the ACEType details
  '****************************************************************************
  objACEAceType = objACE.AceType
  ts.WriteLine "AceType: "
   
  If (objACEAceType <> 0) Then
    CheckValue objACEAceType, ADS_ACETYPE_SYSTEM_AUDIT_OBJECT, "This is a " _
      & "System Audit Entry ACE using a GUID"
    CheckValue objACEAceType, ADS_ACETYPE_ACCESS_DENIED_OBJECT, "This is an " _
      & "Access Denied ACE using a GUID"
    CheckValue objACEAceType, ADS_ACETYPE_ACCESS_ALLOWED_OBJECT, "This is an " _
      & "Access Allowed ACE using a GUID."
    CheckValue objACEAceType, ADS_ACETYPE_SYSTEM_AUDIT, "This is a System " _
      & "Audit Entry ACE using a Windows NT Security Descriptor."
    CheckValue objACEAceType, ADS_ACETYPE_ACCESS_DENIED, "This is an Access " _
      & "Denied ACE using a Windows NT Security Descriptor."
  Else
    ts.WriteLine vbTab & "This is an Access Allowed ACE using a Windows NT " _
      & "Security Descriptor."
  End If
   
  '****************************************************************************
  'Write out the AccessMask details
  '****************************************************************************
  objACEAccessMask = objACE.AccessMask
  ts.WriteLine "Access Mask: "
    
  If objACEAccessMask = FULL_CONTROL Then
    ts.WriteLine vbTab & "Full Control"
  ElseIf (objACEAccessMask <> 0) Then
    CheckValue objACEAccessMask, ADS_RIGHT_GENERIC_READ, "Right to read from " _
      & "the security descriptor, to examine the object and its children, and " _
      & "to read all properties."
    CheckValue objACEAccessMask, ADS_RIGHT_GENERIC_WRITE, "Right to write all " _
      & "properties and write to the DACL. User can also add/remove the " _
      & "object from the tree."
    CheckValue objACEAccessMask, ADS_RIGHT_GENERIC_EXECUTE, "Right to list " _
      & "children of the object."
    CheckValue objACEAccessMask, ADS_RIGHT_GENERIC_ALL, "Right to " _
      & "create/delete children, delete the tree, read/write properties, " _
      & "examine the object and its children, add/remove the object from the " _
      & "tree, and read/write with an extended right."
    CheckValue objACEAccessMask, ADS_RIGHT_ACCESS_SYSTEM_SECURITY, "The right " _
      & "to get or set the SACL in the SD of the object."
    CheckValue objACEAccessMask, ADS_RIGHT_SYNCHRONIZE, "The right to use the " _
      & "object for synchronization."
    CheckValue objACEAccessMask, ADS_RIGHT_WRITE_OWNER, "Right to assume " _
      & "ownership of the object; no right to grant ownership to others. " _
      & "[User must be a trustee of the object]."
    CheckValue objACEAccessMask, ADS_RIGHT_WRITE_DAC, "Right to write to the " _
      & "DACL of the object."
    CheckValue objACEAccessMask, ADS_RIGHT_READ_CONTROL, "Right to read from " _
      & "the security descriptor of the object."
    CheckValue objACEAccessMask, ADS_RIGHT_DELETE, "Right to delete the object."
   
    lngBeforeChange = objACEAccessMask
    CheckValue objACEAccessMask, ADS_RIGHT_DS_CONTROL_ACCESS, "Right to " _
      & "perform an application specific extension on the object."
    If (objACEAccessMask <> lngBeforeChange) Then
      PrintGUID objACE.ObjectType
    End If
   
    CheckValue objACEAccessMask, ADS_RIGHT_DS_LIST_OBJECT, "Right to examine " _
      & "the object. [If this is missing the object is hidden from the user]."
    CheckValue objACEAccessMask, ADS_RIGHT_DS_DELETE_TREE, "Right to delete " _
      & "all children of this object, regardless of the permission on the " _
      & "children."
    
    lngBeforeChange = objACEAccessMask
    CheckValue objACEAccessMask, ADS_RIGHT_DS_WRITE_PROP, "Right to write " _
      & "properties of the object."
    If (objACEAccessMask <> lngBeforeChange) Then
      If objACE.ObjectType = "" Then
        ts.WriteLine vbTab & vbTab & "All properties can be written."
      Else
        PrintGUID objACE.ObjectType
      End If
    End If
   
    lngBeforeChange = objACEAccessMask
    CheckValue objACEAccessMask, ADS_RIGHT_DS_READ_PROP, "Right to read " _
      & "properties of the object."
    If (objACEAccessMask <> lngBeforeChange) Then
      If objACE.ObjectType = "" Then
        ts.WriteLine vbTab & vbTab & "All properties can be read."
      Else
        PrintGUID objACE.ObjectType
      End If
    End If
   
    CheckValue objACEAccessMask, ADS_RIGHT_DS_SELF, "Right to modify the " _
      & "group membership of a group object."
    CheckValue objACEAccessMask, ADS_RIGHT_ACTRL_DS_LIST, "Right to examine " _
      & "children of the object."
    
    lngBeforeChange = objACEAccessMask
    CheckValue objACEAccessMask, ADS_RIGHT_DS_DELETE_CHILD, "Right to delete " _
      & "children of the object"
    If (objACEAccessMask <> lngBeforeChange) Then
      If objACE.ObjectType = "" Then
        ts.WriteLine vbTab & vbTab & "All Children inherit this right."
      Else
        PrintGUID objACE.ObjectType
      End If
    End If
    
    lngBeforeChange = objACEAccessMask
    CheckValue objACEAccessMask, ADS_RIGHT_DS_CREATE_CHILD, "Right to create " _
      & "children of the object"
    If (objACEAccessMask <> lngBeforeChange) Then
      If objACE.ObjectType = "" Then
        ts.WriteLine vbTab & vbTab & "All Children inherit this right."
      Else
        PrintGUID objACE.ObjectType
      End If
    End If
   
  Else
    ts.WriteLine vbTab & "ACE Access Mask is 0, therefore no permissions " _
      & "exist for this ACE!"
  End If
   
  '****************************************************************************
  'Write out the ACEFlags details
  '****************************************************************************
  objACEAceFlags = objACE.AceFlags
  ts.WriteLine "ACEFlags: "
    
  If (objACEAceFlags <> 0) Then
    CheckValue objACEAceFlags, ADS_ACEFLAG_FAILED_ACCESS, "SACL: Generates " _
      & "audit messages for failed access attempts."
    CheckValue objACEAceFlags, ADS_ACEFLAG_SUCCESSFUL_ACCESS, "SACL: " _
      & "Generates audit messages for successful access attempts."
    CheckValue objACEAceFlags, ADS_ACEFLAG_VALID_INHERIT_FLAGS, "Indicates " _
      & "whether the inherit flags are valid. [Set only by the system]."
    CheckValue objACEAceFlags, ADS_ACEFLAG_INHERITED_ACE, "Indicates whether " _
      & "or not the ACE was inherited. [Set only by the system]."
    CheckValue objACEAceFlags, ADS_ACEFLAG_INHERIT_ONLY_ACE, "Indicates an " _
      & "inherit-only ACE that does not exercise access controls on the " _
      & "object to which it is attached."
    CheckValue objACEAceFlags, ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE, "Child " _
      & "objects will not inherit this ACE."
    CheckValue objACEAceFlags, ADS_ACEFLAG_INHERIT_ACE, "Child objects will " _
      & "inherit this ACE."
  Else
    ts.WriteLine vbTab & "ACE is not inherited by children."
  End If
    
  '****************************************************************************
  'Write out the Flags details
  '****************************************************************************
  ts.WriteLine "Flags: "
    
  If (objACE.Flags = 0) Then
    ts.WriteLine vbTab & "Object Type and Inherited Object Type aren't present."
  ElseIf (objACE.Flags = ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT) Then
    ts.WriteLine vbTab & "Inherited Object Type present: "
    PrintGUID objACE.InheritedObjectType
  ElseIf (objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT) Then
    ts.WriteLine vbTab & "Object Type present: "
    PrintGUID objACE.ObjectType
  ElseIf (objACE.Flags = (ADS_FLAG_OBJECT_TYPE_PRESENT + _
    ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT)) Then
    'Both present, so print the GUIDs
   
    ts.WriteLine vbTab & "Inherited Object Type present: "
    PrintGUID objACE.InheritedObjectType
   
    ts.WriteLine vbTab & "Object Type present: "
    PrintGUID objACE.ObjectType
  End If
   
  intCount = intCount + 1
Next
   
'****************************************************************************
'Write out the SACL general information
'****************************************************************************
Set objSACL = objSecDesc.SystemAcl      'System Auditing List
   
ts.WriteLine "----------"
ts.WriteLine "----------"
ts.WriteLine "System ACL"
ts.WriteLine "----------"
ts.WriteLine "----------"
ts.WriteLine "There are " & objSACL.AceCount & " ACEs in the SACL."
ts.WriteLine "SACL revision is: " & objSACL.AclRevision
 
intCount = 1
For Each objACE In objSACL
  ts.WriteLine "----------------------------------------------------------------"
  ts.WriteLine "ACE Trustee " & intCount & " of " & objSACL.AceCount & " is: " _
    & objACE.Trustee
   
  '****************************************************************************
  'Add the ACEType, AccessMask, ACEFlags, and Flags code here from the preceding.
  'The code has been cut to save wasting space by duplicating it in the book.
  'You could even move the entire section of code to a Sub rather than including
  'it twice.
  '****************************************************************************
    
  intCount = intCount + 1
Next
   
ts.WriteLine "------------------------------------------------------------------"
ts.Close
   
MsgBox "End!"