Update Cluster State

Microsoft.Amalga.Library.UpdateClusterState (WriteActionModuleType)

write probe - queries the MSCS cluster api for a resource group and writes the state (active/passive) to the registry.

Element properties:

TypeWriteActionModuleType
IsolationAny
AccessibilityInternal
RunAsDefault
InputTypeSystem.BaseData
OutputTypeSystem.CommandOutput

Member Modules:

ID Module Type TypeId RunAs 
UpdateClusterStateScript WriteAction Microsoft.Windows.ScriptWriteAction Default

Overrideable Parameters:

IDParameterTypeSelectorDisplay NameDescription
DebugEnabledbool$Config/DebugEnabled$Log EnabledFor debugging management pack script issues. Not recommended for general use.
TimeoutSecondsstring$Config/TimeoutSeconds$Timeout Seconds

Source Code:

<WriteActionModuleType ID="Microsoft.Amalga.Library.UpdateClusterState" Accessibility="Internal" Batching="false">
<Configuration>
<xsd:element minOccurs="1" name="DebugEnabled" type="xsd:boolean"/>
<xsd:element minOccurs="1" name="PrincipalName" type="xsd:string"/>
<xsd:element minOccurs="1" name="NetBIOSComputerName" type="xsd:string"/>
<xsd:element minOccurs="1" name="Environment" type="xsd:string"/>
<xsd:element minOccurs="1" name="BoxEnvNum" type="xsd:string"/>
<xsd:element minOccurs="1" name="TimeoutSeconds" type="xsd:integer"/>
<xsd:element minOccurs="1" name="DebugEventSource" type="xsd:string"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="DebugEnabled" Selector="$Config/DebugEnabled$" ParameterType="bool"/>
<OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="string"/>
</OverrideableParameters>
<ModuleImplementation Isolation="Any">
<Composite>
<MemberModules>
<WriteAction ID="UpdateClusterStateScript" TypeID="Windows!Microsoft.Windows.ScriptWriteAction">
<ScriptName>AmalgaUpdateClusterState.vbs</ScriptName>
<Arguments>"$Target/Id$"</Arguments>
<ScriptBody><Script>'' AmalgaUpdateClusterState.vbs
''

''------------------------------------------------------------------------------------------
Option Explicit
SetLocale("en-us")

const SCRIPT_VERSION = "1.0"
dim WRITELINEHEADER
WRITELINEHEADER = "AmalgaUpdateClusterState.vbs" &amp; vbcrlf &amp; "Microsoft.Amalga.Library.UpdateClusterState" &amp; vbcrlf &amp; "script version: " &amp; SCRIPT_VERSION &amp; vbcrlf &amp; "script start: " &amp; now()

const EXPECTED_PARAM_COUNT = 1

const LOGSEVERITY_INFO = 4
const LOGSEVERITY_WARN = 2
const LOGSEVERITY_ERROR = 1

dim LogEnabled
LogEnabled = false
dim ManagedEntityId
ManagedEntityId = ""

Dim oAPI
Set oAPI = CreateObject("MOM.ScriptAPI")

dim DebugEventSource
dim LogEventSource
dim LogSeverity
LogSeverity = LOGSEVERITY_INFO

DebugEventSource = "$Config/DebugEventSource$"
if instr(DebugEventSource,"$") then
LogEventSource = "Amalga"
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in DebugEventSource - $ not translated - " &amp; DebugEventSource
cdate("unexpected error - macro subsitution did not happen")
else
LogEventSource = trim(DebugEventSource &amp; "")
if (LogEventSource = "") then
LogEventSource = "Amalga"
LogEnabled = true
LogSeverity = LOGSEVERITY_WARN
WriteLine "missing DebugEventSource, defaulting to 'Amalga'"
LogEnabled = false
LogSeverity = LOGSEVERITY_INFO
end if
end if

Dim oArgs
Set oArgs = WScript.Arguments
DumpArgs(oArgs)

if (oArgs.Count &lt;&gt; EXPECTED_PARAM_COUNT) then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "invalid arg count: " &amp; oArgs.Count &amp; " expected " &amp; EXPECTED_PARAM_COUNT
oArgs = cdate("invalid arg count") ''' intentionally crash
end if


ManagedEntityId = GetArg(oArgs(0))


dim DebugEnabled
DebugEnabled = "$Config/DebugEnabled$"
if instr(DebugEnabled,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in DebugEnabled - $ not translated - " &amp; DebugEnabled
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if
DebugEnabled = trim(ucase(DebugEnabled &amp; " "))
LogEnabled = (DebugEnabled = "TRUE")



''------------------------------------------------------------------------------------------

Public objArgs, objCluster
public TargetServerVIP
public FoundVIPinResourceGroup, ClusterConnectErrorMsg
public strResGroupName, strResGroupOwnerNode

const ActiveState = "Active"
const PassiveState = "Passive"
const NotClusterState = "NotCluster"


Dim TargetComputer, PrincipalName, NetBIOSComputerName, Environment, BoxEnvNum, ThisMachineName

TargetComputer = "$Config/PrincipalName$"
if instr(TargetComputer,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in serviceinstancename - $ not translated - " &amp; serviceinstancename
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if
PrincipalName = TargetComputer

NetBIOSComputerName = "$Config/NetBIOSComputerName$"
if instr(NetBIOSComputerName,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine "Error in serviceinstancename - $ not translated - " &amp; serviceinstancename
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if

Environment = "$Config/Environment$"
if instr(Environment,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if

BoxEnvNum = "$Config/BoxEnvNum$"
if instr(BoxEnvNum,"$") then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
cdate("unexpected error - macro subsitution did not happen") ''' intentionally crash
end if

WriteLine("LogEnabled=" &amp; LogEnabled &amp; " (DebugEnabled:" &amp; DebugEnabled &amp; ")")
WriteLine("TargetComputer=" &amp; TargetComputer)
WriteLine("PrincipalName=" &amp; PrincipalName)
WriteLine("NetBIOSComputerName=" &amp; NetBIOSComputerName)
WriteLine("Environment=" &amp; Environment)
WriteLine("BoxEnvNum=" &amp; BoxEnvNum)

WriteLine "running script on machine: "
dim wshshell, objenv
on error resume next
Set WshShell = CreateObject("WScript.Shell")
Set objEnv = WshShell.Environment("Process")
ThisMachineName = "" &amp; objEnv("COMPUTERNAME")
WriteLine "This machine's name is: " &amp; ThisMachineName
on error goto 0

'' We can have several targets resolving to the same box, but we want to only allow the registry to be updated from the physical box
'' so we don't confuse it when computing the active/passive state
if trim(lcase(NetBIOSComputerName) &amp; " ") &lt;&gt; trim(lcase(ThisMachineName) &amp; " ") then
WriteLine("NetBIOSComputerName does not equal physical box's hostname, skipping cluster state update operations.")
else
'' empty BoxEnvNum indicates the class was discovered from another node, so the same Environment keys might not exist on both nodes
if (BoxEnvNum &lt;&gt; "0" and BoxEnvNum &lt;&gt; "") then
WriteLine "There are potentially more than 1 environments configured for this physical server, skipping this environment so we don't hit concurrency issues while writing to the same registry keys."
else
call UpdateClusterStates(TargetComputer, NetBIOSComputerName)
end if
end if


WriteLine("end script. " &amp; Now())


''------------------------------------------------------------------------------------------

'////////////////////////////

sub DumpArgs(Args)
dim i, status
WriteLine("Dumping args as passed in.")
WriteLine("Note: If you see quotes, they are actually part of the argument literal.")
dim untranslated
untranslated = false
for i = 0 to Args.Count - 1
WriteLine(i &amp; ": " &amp; Args(i))
if (instr(Args(i),"$") &gt; 0) then
untranslated = true
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine("ERROR: untranslated $ encountered at arg " &amp; i &amp; ": " &amp; Args(i))
end if
next
if (untranslated) then
LogEnabled = true
LogSeverity = LOGSEVERITY_ERROR
WriteLine("ERROR: one or more untranslated $ args encountered, quitting.")
status = cdate("ERROR: one or more untranslated $ args encountered, quitting.") ''' intentionally crash here
end if

end sub

'////////////////////////////

function GetArg(quotedarg)
dim s
s = quotedarg
if s &lt;&gt; "" then
if mid(s,1,1) = """" then
s = mid(s,2, len(s)-1)
end if
if mid(s,len(s),1) = """" then
s = mid(s, 1, len(s)-1)
end if
end if
GetArg = s
end function

'////////////////////////////

sub WriteLine(in_line)

if (LogEnabled) then
dim s
s = vbcrlf &amp; "ID: " &amp; ManagedEntityId &amp; vbcrlf &amp; WRITELINEHEADER &amp; vbcrlf &amp; vbcrlf &amp; in_line

wscript.echo in_line
call oAPI.LogScriptEvent(LogEventSource, 100, LogSeverity, s)
end if

end sub

'////////////////////////////

Function Connect(server)
'
' Opens a global cluster object. Using Windows Script Host syntax,
' the cluster name or "" must be passed as the first argument.
'
WriteLine "connecting to " &amp; server
ClusterConnectErrorMsg = ""
on error resume next
Set objCluster = Nothing
Set objCluster = CreateObject("MSCluster.Cluster")
if (Err.Number &lt;&gt; 0) or (objCluster is nothing) then
ClusterConnectErrorMsg = Err.Number &amp; " - " &amp; Err.description &amp; " (" &amp; TargetComputer &amp; ")"
if Err.Number = 429 then '' activex object not registered, MSCS not installed
WriteLine "ClusterConnectErrorMsg = " &amp; ClusterConnectErrorMsg
ClusterConnectErrorMsg = "MSCS not installed (" &amp; TargetComputer &amp; ")"
end if
WriteLine "could not instantiate MSCS to connect to " &amp; server
WriteLine "ClusterConnectErrorMsg = " &amp; ClusterConnectErrorMsg
call WriteClusterState(server, NotClusterState, ClusterConnectErrorMsg)
exit function
else
WriteLine "instantiated MSCS to connect to " &amp; server
end if
objCluster.Open server
if (Err.Number &lt;&gt; 0) then
ClusterConnectErrorMsg = Err.Number &amp; " - " &amp; Err.description &amp; " (" &amp; TargetComputer &amp; ")"
WriteLine "Error opening connection to " &amp; server &amp; " closing MSCS object!"
WriteLine "ClusterConnectErrorMsg = " &amp; ClusterConnectErrorMsg
Set objCluster = Nothing
call WriteClusterState(server, NotClusterState, ClusterConnectErrorMsg)
end if
on error goto 0
End Function

sub Disconnect()
'
' Dereferences global objects. Used with Connect.
'
Set objCluster = Nothing
Set objArgs = Nothing
end sub

sub EnumerateResourceGroups(in_TargetComputer, in_TargetVIP)
'
' Returns a delimited string of names from a collection.
' Objects in the collection must support the Name property.
'
dim i, Value, objEnum

WriteLine "EnumerateResourceGroups()"

if (objCluster is nothing) then
WriteLine "could not instantiate MSCS objects, exiting early!"
exit sub
end if

dim targetVIP
targetVIP = lcase(trim(in_TargetVIP &amp; " "))
if targetVIP = "" then
WriteLine "invalid targetVIP"
exit sub
end if


dim f
f = -1
on error resume next
f = objCluster.Resources.count
on error goto 0
WriteLine "objCluster.Resources.count = " &amp; f
if f &lt;= 0 then
WriteLine "exiting early!"
exit sub
end if

dim j, VIPgroupname, VIPgroupowner, VIPgroupNetworkName
dim domain

domain = GetDomainFromTargetComputer(in_TargetComputer)

'' record self before enumerating clusters
call WriteClusterState(in_TargetComputer, NotClusterState, "recording self")

on error resume next

for i = 1 to f
If LCase(objCluster.Resources.Item(i).TypeName) = "network name" Then
For j = 1 To objCluster.Resources.Item(i).PrivateProperties.Count
If LCase(objCluster.Resources.Item(i).PrivateProperties(j).Name) = "name" Then
VIPgroupname = objCluster.Resources.Item(i).Group.Name
VIPgroupNetworkName = objCluster.Resources.Item(i).PrivateProperties(j).Value
End If
next

VIPgroupNetworkName = lcase(trim(VIPgroupNetworkName &amp; " "))
WriteLine "group " &amp; VIPgroupname &amp; "'s network name: " &amp; VIPgroupNetworkName
if (domain &lt;&gt; "") and (instr(VIPgroupNetworkName,domain) = 0) then
WriteLine "Domain " &amp; domain &amp; " is missing, adding it"
VIPgroupNetworkName = VIPgroupNetworkName &amp; "." &amp; domain
end if
WriteLine "VIPgroupNetworkName = " &amp; VIPgroupNetworkName
VIPgroupowner = "unknown node owner"
VIPgroupowner = lcase(trim(objCluster.Resources.Item(i).Group.OwnerNode.Name &amp; " "))
WriteLine "VIPgroupowner = " &amp; VIPgroupowner
WriteLine VIPgroupowner &amp; " owns " &amp; VIPgroupNetworkName
if VIPgroupowner = targetVIP then
call WriteClusterState(VIPgroupNetworkName, ActiveState, VIPgroupowner &amp; " owns " &amp; VIPgroupNetworkName)
else
call WriteClusterState(VIPgroupNetworkName, PassiveState, VIPgroupowner &amp; " owns " &amp; VIPgroupNetworkName)
end if

End If
next
on error goto 0

end sub

Function GetValue(obj)
dim retval
retval=""
on error resume next
retval = obj.Value &amp; ""
on error goto 0
GetValue = retval
End Function



sub UpdateClusterStates(in_TargetComputer, in_NetBIOSComputerName)

call Connect(in_TargetComputer)
call EnumerateResourceGroups(in_TargetComputer, in_NetBIOSComputerName)
Disconnect

end sub
'////////////////////////////

sub WriteClusterState(in_clustername, in_state, in_errormsg)

WriteLine "Writing " &amp; in_clustername &amp; "'s cluster state (" &amp; in_state &amp; ") to the registry."
WriteLine "errormsg: " &amp; in_errormsg

dim oReg, strComputer, strKeyPath, strValueName, strValue


Const HKEY_LOCAL_MACHINE = &amp;H80000002

''strComputer = "."
strComputer = principalname


Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &amp; _
strComputer &amp; "\root\default:StdRegProv")


strKeyPath = "SOFTWARE\Microsoft\Amalga\SCOM\Volatile\Clusters\" &amp; lcase(in_clustername)

oReg.CreateKey HKEY_LOCAL_MACHINE, strKeyPath

strValueName = "State"
strValue = in_state
oReg.SetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue

strValueName = "LastUpdated"
strValue = cstr(now())
oReg.SetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue

strValueName = "ErrorInfo"
strValue = in_errormsg
oReg.SetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue

end sub
'////////////////////////////
function GetDomainFromTargetComputer(machinename)
dim pos, temp
temp = machinename
temp = lcase(" " &amp; temp &amp; " ")
pos = instr(temp,".")
if (pos &gt;0) then
GetDomainFromTargetComputer = trim(mid(temp,pos+1))
else
GetDomainFromTargetComputer = ""
end if
end function
'////////////////////////////

function NormalizeDate(x)
dim retval, i, L, c

L = len(x)
for i = 1 to L
c = ucase(mid(x,i,1))
if (instr("/:AMP ",c)=0) then
retval = retval &amp; c
end if
next

NormalizeDate = retval
end function

'////////////////////////////
</Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</WriteAction>
</MemberModules>
<Composition>
<Node ID="UpdateClusterStateScript"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.CommandOutput</OutputType>
<InputType>System!System.BaseData</InputType>
</WriteActionModuleType>