'---------------------------------------------------------------------------------------------------------
'
' Microsoft Corporation
' Copyright (c) Microsoft Corporation. All rights reserved.
'
' Common - Certificate Services MP Common Library
' This script defines various useful functions and subroutines used by the Certificate
' Services Management Pack.
'
'---------------------------------------------------------------------------------------------------------
'constants needed for registry access
const HKEY_LOCAL_MACHINE = &H80000002
'constants for communicating with CAs
const CR_OUT_BASE64HEADER = 0
const CR_OUT_BASE64 = &H1
const CR_OUT_BINARY = &H2
const CR_OUT_CHAIN = &H100
const CR_OUT_CRLS = &H200
'---------------------------------------------------------------------------
' Initializes the "library".
'---------------------------------------------------------------------------
sub InitializeCommon(iScriptEventID)
'set the script event id
SCRIPT_EVENT_ID = iScriptEventID
end sub
'---------------------------------------------------------------------------
' Used for storing error information and other things.
'---------------------------------------------------------------------------
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class
'---------------------------------------------------------------------------
' Implements a subset of typical dynamic list functionality.
'---------------------------------------------------------------------------
class List
private m_aData
private m_iCount
private m_iCapacityIncrement
'---------------------------------------------------------------------------
' Creates an empty list.
'---------------------------------------------------------------------------
private sub Class_Initialize()
'allocate a dynamic array of size 0
m_aData = Array(0)
'set counts
m_iCount = 0
'set default increment
m_iCapacityIncrement = 10
end sub
'---------------------------------------------------------------------------
' Destroys the list.
'---------------------------------------------------------------------------
private sub Class_Terminate()
'deallocate the array
redim m_aData(0)
end sub
'---------------------------------------------------------------------------
' Getter for data (no range checking).
'---------------------------------------------------------------------------
public property get Data(iIndex)
if IsObject(m_aData(iIndex)) then
set Data = m_aData(iIndex)
else
Data = m_aData(iIndex)
end if
end property
'---------------------------------------------------------------------------
' Setter for data (no range checking).
'---------------------------------------------------------------------------
public property let Data(iIndex, vValue)
if IsObject(vValue) then
set m_aData(iIndex) = vValue
else
m_aData(iIndex) = vValue
end if
end property
'---------------------------------------------------------------------------
' Gets the whole array.
'---------------------------------------------------------------------------
public property get DataArray()
DataArray = m_aData
end property
'---------------------------------------------------------------------------
' Gets the number of items currently stored in the list.
'---------------------------------------------------------------------------
public property get Count()
Count = m_iCount
end property
'---------------------------------------------------------------------------
' Gets the current capacity of the list. (Adding beyond capacity will cause
' the list to be resized/reallocated.
'---------------------------------------------------------------------------
public property get Capacity()
Capacity = UBound(m_aData)
end property
'---------------------------------------------------------------------------
' Gets number of items by which the array size will be increased when it
' needs to be reallocated.
'---------------------------------------------------------------------------
public property get CapacityIncrement()
CapacityIncrement = m_iCapacityIncrement
end property
'---------------------------------------------------------------------------
' Sets the number of items by which the array will be lengthened when it
' needs reallocating. (No effect if value is less than 1.)
'---------------------------------------------------------------------------
public property let CapacityIncrement(iValue)
if iValue > 0 then
m_iCapacityIncrement = iValue
end if
end property
'---------------------------------------------------------------------------
' Adds an item to the list. (List will be resized/reallocated as needed.)
'---------------------------------------------------------------------------
public function Add(vItem)
'do we have space?
if m_iCount >= UBound(m_aData) then
'no
'reallocate array
redim preserve m_aData(UBound(m_aData) + CapacityIncrement)
end if
'add it
Data(m_iCount) = vItem
'increment count
m_iCount = m_iCount + 1
end function
end class
'---------------------------------------------------------------------------
' Returns "< sCurrent >, < sNew > if sCurrent is non-empty. Otherwise, returns
' sNew.
'---------------------------------------------------------------------------
function AppendToCSL(sCurrent, sNew)
dim sResult
sResult = sCurrent
'something already in the list?
if sCurrent <> "" then
'yes
'add a separator
sResult = sResult & ", "
end if
'concat new item
sResult = sResult & sNew
'return
AppendToCSL = sResult
end function
'---------------------------------------------------------------------------
' Converts a hex digit to an integer. (no error checking)
'---------------------------------------------------------------------------
function HexDigitToInt(hexDigit)
HexDigitToInt = (InStr ("0123456789ABCDEF", UCase(hexDigit))) - 1
end function
'---------------------------------------------------------------------------
' Converts a hex string to an integer. (no error checking)
'---------------------------------------------------------------------------
function HexStringToInt(hexString)
dim temp
dim i
temp = 0
for i = 1 to len(hexString)
temp = temp * 16
temp = temp + HexDigitToInt(mid(hexString, i, 1))
next
HexStringToInt = temp
end function
'---------------------------------------------------------------------------
' Retrieves a WMI object from the specified namespace.
'---------------------------------------------------------------------------
function GetWMIObject(ByVal sNamespace)
dim oWMI
dim e
set e = new Error
'get the object
on error resume next
set oWMI = GetObject(sNamespace)
e.Save
on error goto 0
'did it work?
if IsEmpty(oWMI) then
'no
ThrowScriptError "Unable to open WMI Namespace '" & sNamespace & "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
end if
set GetWMIObject = oWMI
end function
'---------------------------------------------------------------------------
' Retrieves a WMI registry object
'---------------------------------------------------------------------------
function GetRegistryObject(ByVal sComputerName)
set GetRegistryObject = GetWMIObject("winmgmts:\\" & sComputerName & "\root\default:StdRegProv")
end function
'---------------------------------------------------------------------------
' Retrieves a Cimv2 object needed by ServiceExists.
'---------------------------------------------------------------------------
function GetWMICimv2Object(ByVal sComputerName)
set GetWMICimv2Object = GetWMIObject("winmgmts:\\" & sComputerName & "\root\cimv2")
end function
'---------------------------------------------------------------------------
' Returns true if specified service exists on the machine.
'---------------------------------------------------------------------------
function ServiceExists(oCimv2, ByVal sServiceName)
dim oResult, bTemp, sQuery, e
set e = new Error
'run the query
sQuery = "Select * from win32_service where name = '" & sServiceName & "'"
on error resume next
set oResult = oCimv2.ExecQuery(sQuery)
e.Save
on error goto 0
'valid result?
if IsEmpty(oResult) or e.Number <> 0 then
'no
ThrowScriptError "The Query '" & sQuery & "' returned an invalid result set. Please check to see if this is a valid WMI Query.", e
end if
'check if service exists
on error resume next
bTemp = (oResult.Count > 0)
e.Save
on error goto 0
'error getting instance count?
if e.Number <> 0 then
'yes
ThrowScriptError "The Query '" & sQuery & "' did not return any valid instances. Please check to see if this is a valid WMI Query.", e
end if
ServiceExists = bTemp
end function
'---------------------------------------------------------------------------
' Returns discovery snapshot to the agent.
'---------------------------------------------------------------------------
sub ReturnSnapshot(data)
data.IsSnapshot = true
call oAPI.Return(data)
WScript.Quit
end sub
'---------------------------------------------------------------------------
' Returns incremental discovery data to the agent.
'---------------------------------------------------------------------------
sub ReturnIncremental(data)
data.IsSnapshot = false
call oAPI.Return(data)
WScript.Quit
end sub
'---------------------------------------------------------------------------
' Returns name of the current script.
'---------------------------------------------------------------------------
function GetScriptName
dim oFSO
'get object (with error checking)
set oFSO = MOMCreateObject("Scripting.FileSystemObject")
GetScriptName = oFSO.GetFile(WScript.ScriptFullName).Name
set oFSO = nothing
end function
'---------------------------------------------------------------------------
' Creates an event in the log with the specified message and severity.
'---------------------------------------------------------------------------
sub LogEvent(message, severity)
dim oTempAPI, sScriptName
'get script name
sScriptName = GetScriptName
'create a temp mom api object
'(avoids having to pass the object every time or using a global)
set oTempAPI = MOMCreateObject("MOM.ScriptAPI")
'log event
on error resume next
call oTempAPI.LogScriptEvent(sScriptName, SCRIPT_EVENT_ID, severity, message)
on error goto 0
'if there's an error from the above, just eat it
end sub
'---------------------------------------------------------------------------
' Creates a COM object and returns it (with error checking).
'---------------------------------------------------------------------------
function MOMCreateObject(ByVal sName)
dim e
set e = new Error
'create the object
on error resume next
set MOMCreateObject = CreateObject(sName)
e.Save
on error goto 0
if e.Number <> 0 then
ThrowScriptError "Unable to create COM object '" & sName & "'", e
end if
end function
'---------------------------------------------------------------------------
' Creates an event and sends it back to the mom server without stopping
' the script.
'---------------------------------------------------------------------------
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
' Retrieve the name of this (running) script
Dim sScriptFileName
sScriptFileName = GetScriptName
If Not IsNull(oErr) Then
sMessage = sMessage & " Cause: " & oErr.Description
end if
On Error Resume Next
Dim oAPITemp
Set oAPITemp = CreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent sScriptFileName, SCRIPT_EVENT_ID, SCOM_ERROR, sMessage
On Error Goto 0
WScript.Echo sMessage
End Function
'---------------------------------------------------------------------------
' Creates an error event, sends it back to the mom server, and stops the
' script.
'---------------------------------------------------------------------------
Function ThrowScriptError(Byval sMessage, ByVal oErr)
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
WScript.Quit
End Function
'---------------------------------------------------------------------------
' Creates a registry key to hold state information and returns its path.
'---------------------------------------------------------------------------
function CreateCacheRegKey(reg, identifier)
dim e, path
set e = new Error
'get the path
path = oAPI.GetScriptStateKeyPath("ADCS") & "\" & identifier
'create the key
on error resume next
call reg.CreateKey(HKEY_LOCAL_MACHINE, path)
e.Save
on error goto 0
if e.Number <> 0 then
ThrowScriptError "Unable to create registry key 'HKLM\" & path & "'.", e
end if
'return path
CreateCacheRegKey = path
end function
'---------------------------------------------------------------------------
' Gets the PrincipalName out of a CA config string.
'---------------------------------------------------------------------------
function GetPrincipalName(configString)
dim iBackslashIndex
'find the \
iBackslashIndex = InStr(1, configString, "\")
if iBackslashIndex = 0 then
'\ not found. something's weird
ThrowScriptError "Config string '" & configString & "' is not valid.", null
end if
'grab the principal name and return
GetPrincipalName = Left(configString, iBackslashIndex - 1)
end function
'---------------------------------------------------------------------------
' Gets the CAName out of a CA config string.
'---------------------------------------------------------------------------
function GetCAName(configString)
dim iBackslashIndex
'find the \
iBackslashIndex = InStr(1, configString, "\")
if iBackslashIndex = 0 then
'\ not found. something's weird
ThrowScriptError "Config string '" & configString & "' is not valid.", null
end if
'grab the ca name and return
GetCAName = Right(configString, Len(configString) - iBackslashIndex)
end function
'---------------------------------------------------------------------------
' Retrieves a CA Cert from the specified CA config string and returns it
' as a Base64-encoded string. Returns empty string if certificate could
' not be retrieved.
'---------------------------------------------------------------------------
function GetCACert(oCertRequest, configString)
dim e
set e = new Error
dim sCACert
'get CA cert
on error resume next
sCACert = oCertRequest.GetCACertificate(1, configString, CR_OUT_BASE64)
e.Save
on error goto 0
'error?
if e.Number <> 0 then
'no cert
GetCACert = ""
else
'return the cert
GetCACert = sCACert
end if
end function
'---------------------------------------------------------------------------
' Saves a string to a temp file and returns the file name.
'---------------------------------------------------------------------------
function SaveStringToTempFile(data)
dim sTempFileName
dim e
set e = new Error
dim oWriter
'generate temp file name (current directory is already set by the agent)
sTempFileName = oFSO.GetTempName()
'open text file for writing
on error resume next
set oWriter = oFSO.OpenTextFile(sTempFileName, ForWriting, true)
e.Save
on error goto 0
if e.Number <> 0 then
ThrowScriptError "Unable to open file '" & sTempFileName & "' for writing.", e
end if
'save it to file
on error resume next
oWriter.WriteLine(data)
e.Save
on error goto 0
if e.Number <> 0 then
ThrowScriptError "Unable to save data to file '" & sTempFileName & "'.", e
end if
'close the file
on error resume next
oWriter.Close
e.Save
on error goto 0
if e.Number <> 0 then
ThrowScriptError "Unable to close file '" & sTempFileName & "'.", e
end if
set oWriter = nothing
'return temp file name
SaveStringToTempFile = sTempFileName
end function
'---------------------------------------------------------------------------------------------------------
'
' Microsoft Corporation
' Copyright (c) Microsoft Corporation. All rights reserved.
'
' CA Role Discovery - Certificate Authority Role Discovery
' This script discovers all instances of Microsoft.Windows.CertificateServices.CARole
'
' Parameters - sSourceID The GUID of the discovery object that launched the script.
' sManagedEntityID The GUID of the computer class targeted by the script.
' sComputerName The FQDN of the computer targeted by the script.
' bDebug True / False
'
' Dependencies - Common.vbs Certificate Services MP Common Library
'
'---------------------------------------------------------------------------------------------------------
dim sSourceID, sManagedEntityID, sComputerName, bDebug
dim oAPI, oRegex, oFSO, oShell
'---------------------------------------------------------------------------
' Parses certutil -verify output and returns an array of CA names with
' current CA first and root last. Also returns the number of valid array
' entries in the CACount parameter. (Depends on the oRegex global.)
'---------------------------------------------------------------------------
function ParseCertutilVerifyOutput(ByVal certutilOutput, ByRef CACount)
dim bRootFound, sPrevName, i, bRoot, oMatches
'find matches
set oMatches = oRegex.Execute(certutilOutput)
'allocate array for CA names
redim aCANames(oMatches.Count)
'empty array
CACount = 0
'root not encountered yet
bRootFound = false
'populate arrays
sPrevName = ""
for i = 0 to oMatches.Count - 1 step 1
'check if cert is self-signed (self-signed = root CA)
if (HexStringToInt(oMatches(i).SubMatches(0)) and 8) > 0 then
'has root been found already?
if bRootFound then
'yes
'should only be one root in the chain
ThrowScriptError "Multiple root CAs found while building certificate chain.", null
else
'no
'update flag
bRootFound = true
end if
end if
'current CA Name different from previous name?
if sPrevName <> oMatches(i).SubMatches(1) then
'yes. add to the array
aCANames(i) = oMatches(i).SubMatches(1)
CACount = CACount + 1
sPrevName = aCANames(i)
else
'no. skip it
end if
next
'make sure a root cert has been found
if not bRootFound then
ThrowScriptError "No root certificate found in the certificate chain.", null
end if
'return the array
ParseCertutilVerifyOutput = aCANames
end function
'---------------------------------------------------------------------------
' Reads the specified file name, builds the certificate chain, and returns
' a list of CANames in an array with root last and current CA first.
'---------------------------------------------------------------------------
function BuildChain(ByVal certFileName, ByRef CACount)
dim sCertutilCmd, oCertutilExec, sCertutilOutput, sCertutilError
dim e
set e = new Error
'run "certutil -verify certFileName" and store output in a string
sCertutilCmd = "certutil -verify " & certFileName
on error resume next
Set oCertutilExec = oShell.Exec(sCertutilCmd)
e.Save
on error goto 0
if e.Number <> 0 then
ThrowScriptError "Unable to run command '" & sCertutilCmd & "'.", e
end if
'dump output and error streams to a strings
sCertutilOutput = oCertutilExec.StdOut.ReadAll
sCertutilError = oCertutilExec.StdErr.ReadAll
set oCertutilExec = nothing
'error stream contains errors?
if sCertutilError <> "" then
'yes
ThrowScriptError "Certutil returned errors while building certificate chain.", null
else
'nope
'parse output and return
BuildChain = ParseCertutilVerifyOutput(sCertutilOutput, CACount)
end if
end function
function GenerateCAChain(oCertRequest, sConfigString)
dim sCACert, sCertFileName, aCANames, iCACount, result, iIndex, e
set e = new Error
'get CA cert
sCACert = GetCACert(oCertRequest, sConfigString)
'did we actually get a cert?
if sCACert <> "" then
'yes
'save cert to temp file
sCertFileName = SaveStringToTempFile(sCACert)
'build the chain
aCANames = BuildChain(sCertFileName, iCACount)
'delete the temp file
on error resume next
oFSO.DeleteFile sCertFileName, true
e.Save
on error goto 0
if e.Number <> 0 then
ThrowScriptErrorNoAbort "Unable to delete temporary file '" & sCertFileName & "'. Discovery will continue.", e
end if
result = ""
for iIndex = 0 to (iCACount - 1)
result = result & aCANames(iIndex)
if iIndex < (iCACount - 1) then
result = result & ","
end if
next
GenerateCAChain = result
else
'nope something went wrong
'toss an event
ThrowScriptErrorNoAbort "Unable to retrieve Exchange certificate from '" & sConfigString & "'.", null
'return empty chain
GenerateCAChain = ""
end if
end function
'---------------------------------------------------------------------------
' Main functionality of the script
'---------------------------------------------------------------------------
sub main
dim oDiscovery, oCARole
dim oWMIcimv2
dim oCA
dim sCAName, sConfigString
dim e, sChain
SetLocale("en-us")
'initialize the "library"
InitializeCommon(1400)
'create required objects
set e = new Error
set oAPI = MOMCreateObject("MOM.ScriptAPI")
set oCA = MOMCreateObject("CertificateAuthority.Request")
set oFSO = MOMCreateObject("Scripting.FileSystemObject")
set oShell = MOMCreateObject("WScript.Shell")
'get parameters
if WScript.Arguments.Count <> 4 then
ThrowScriptError ("Invalid parameters passed to " & GetScriptName & "."), null
end if
sSourceID = WScript.Arguments(0)
sManagedEntityID = WScript.Arguments(1)
sComputerName = WScript.Arguments(2)
on error resume next
bDebug = CBool(WScript.Arguments(3))
e.Save
on error goto 0
if e.Number <> 0 then
ThrowScriptError "Debug flag must be a valid boolean value (true or false).", e
end if
if bDebug then
LogEvent "SourceID: " & sSourceID & " ManagedEntityID: " & sManagedEntityID & " ComputerName: " & sComputerName & " Debug: " & bDebug, SCOM_INFORMATION
end if
'create more required objects
set oWMIcimv2 = GetWMICimv2Object(sComputerName)
'create mom discovery data
set oDiscovery = oAPI.CreateDiscoveryData(0, sSourceID, sManagedEntityID)
'cert svc exists?
if ServiceExists(oWMIcimv2, "certsvc") then
'yes
'get ca name
on error resume next
sCAName = oCA.GetCAProperty(sComputerName, CR_PROP_CANAME, 0, PROPTYPE_STRING, 0)
e.Save
on error goto 0
if e.Number <> 0 then
'can't get CA Name
ThrowScriptErrorNoAbort "Unable to determine the Common Name of the CA hosted by " & sComputerName & ".", e
'return empty incremental discovery data (meaning no changes)
ReturnIncremental(oDiscovery)
else
'CA Name obtained successfully
'set up regex
set oRegex = new RegExp
oRegex.IgnoreCase = true
oRegex.Global = true
oRegex.Multiline = true
oRegex.Pattern = "^CertContext\[0\].+dwInfoStatus=([0-9a-f]+).+\r\n Issuer:.+CN=([^,\r\n]+)"
'figure out config string
sConfigString = sComputerName & "\" & sCAName
if bDebug then
LogEvent "Certificate Service detected. CA Name: " & sCAName & ", ConfigString: " & sConfigString, SCOM_INFORMATION
end if
'build the chain
sChain = GenerateCAChain(oCA, sConfigString)
'did we get a chain?
if sChain = "" then
'no
'log error
ThrowScriptErrorNoAbort "Unable to build the chain for CA with config string '" & sConfigString & "'.", null
'return empty incremental discovery data (meaning no changes)
ReturnIncremental(oDiscovery)
else
'yes
'create CARole instance
set oCARole = oDiscovery.CreateClassInstance("$MPElement[Name='Microsoft.Windows.CertificateServices.CARole.2016']$")
'set display name (without this, the class name is displayed on diagrams and such)
call oCARole.AddProperty("$MPElement[Name='System!System.Entity']/DisplayName$", sComputerName)
if bDebug then
LogEvent "Discovered chain: " & sChain, SCOM_INFORMATION
end if
'add instance to data
call oDiscovery.AddInstance(oCARole)
if bDebug then
LogEvent "CARole instance added.", SCOM_INFORMATION
end if
'return discovery data
ReturnSnapshot(oDiscovery)
end if
end if
else
'no
if bDebug then
LogEvent "Certificate Service not running on " & sComputerName & ".", SCOM_INFORMATION
end if
'return empty snapshot
ReturnSnapshot(oDiscovery)
end if
end sub
Home
PLK 
Show References: