Microsoft Security Advisory: Luka w zabezpieczeniach programu SQL Server umożliwia zdalne wykonywanie kodu

'*************************************************************************************
'Opis: Ten skrypt będzie wykonywany (jako iteracja) kolejno dla wszystkich uruchomionych wystąpień programu SQL Server
'            i odmówi uprawnienia do wykonywania roli publicznej w procedurze sp_replwritetovarbin
'            dla wszystkich wersji, których dotyczy ten problem.
'            JEST TO TYLKO OBEJŚCIE PROBLEMU I NIE NALEŻY GO UŻYWAĆ W PRZYPADKU
'            UDOSTĘPNIENIA I ZAINSTALOWANIA AKTUALIZACJI ZABEZPIECZEŃ.
'*************************************************************************************

OPTION EXPLICIT
ON ERROR RESUME NEXT

' Wartości stałych
CONST EXIT_SUCCESS       = 0
CONST EXIT_FAILURE       = 1
CONST EXIT_NOINSTANCES   = -1
CONST DEFAULTNAMESPACE   = "root\default"
CONST STDREGPROV         = "stdregprov"
CONST HKEY_LOCAL_MACHINE = &H80000002
CONST REG_MULTI_SZ       = 7
CONST REG_SZ             = 1
CONST adCmdText          = 1


Call VBMain()

Function VBMain()
    Err.Clear
    ON ERROR RESUME NEXT

    Dim sInstances(), strInstance, i, TotalCount
    VBMain = EXIT_SUCCESS
    If GetInstances(sInstances, TotalCount) = FALSE Then
        WScript.Quit EXIT_FAILURE
    End If

    If IsEmptyNull(sInstances) Then 
        WScript.Echo "INFORMACJA: Brak wystąpień."
        VBMain = EXIT_NOINSTANCES
        Exit Function
    End If

    For i = 0 To TotalCount-1
        strInstance = sInstances(i,0)
        GetFullInstance strInstance, sInstances(i,1)
        If ApplyFix(sInstances(i,0), strInstance) = FALSE Then
            WScript.Echo "BŁĄD: nie można zastosować obejścia dla wystąpienia " + sInstances(i,0) + "." + vbCRLF
            VBMain = EXIT_FAILURE
        End If
    Next

    WScript.Echo "INFORMACJA: Przetwarzanie wszystkich uruchomionych wystąpień programu SQL zostało zakończone."
End Function

Function GetInstances(ByRef sInstances, ByRef TotalCount)
    Err.Clear
    ON ERROR RESUME NEXT

    Dim sInstances1, sInstances2, i
    Dim instCount1, instCount2
    GetInstances = FALSE

    If NOT GetRegValue ("", HKEY_LOCAL_MACHINE, "Software\Microsoft\Microsoft SQL Server", "InstalledInstances", sInstances1, REG_MULTI_SZ, TRUE) Then
        WScript.Echo "BŁĄD: nie można odczytać wystąpień programu SQL zainstalowanych na komputerze."
        Exit Function
    End If

    sInstances2 = NULL
    If IsOs64Bit() = TRUE Then
        If NOT GetRegValue ("", HKEY_LOCAL_MACHINE, "Software\Microsoft\Microsoft SQL Server", "InstalledInstances", sInstances2, REG_MULTI_SZ, FALSE) Then
            WScript.Echo "BŁĄD: nie można odczytać wystąpień programu SQL zainstalowanych na komputerze."
            Exit Function
        End If
    End If

    If IsEmptyNull(sInstances1) AND IsEmptyNull(sInstances2) Then 
        WScript.Echo "INFORMACJA: Brak wystąpień."
        WScript.Quit EXIT_SUCCESS
    End If

    instCount1 = 0
    instCount2 = 0 
    TotalCount = 0
    If IsEmptyNull(sInstances1) = FALSE Then
        instCount1 = UBound(sInstances1) + 1
        TotalCount = instCount1
    End If

    If IsEmptyNull(sInstances2) = FALSE Then
        instCount2 = UBound(sInstances2) + 1
        TotalCount = TotalCount + instCount2
    End If

    ReDim PRESERVE sInstances(TotalCount,1)
    if instCount1 > 0 Then
        For i = 0 To UBound(sInstances1)
            sInstances(i,0) = sInstances1(i)
            sInstances(i,1) = True
        Next
    End If
    If instCount2 >0 Then
        For i = 0 To UBound(sInstances2)
            sInstances(i+instCount1,0) = sInstances2(i)
            sInstances(i+instCount1,1) = FALSE
        Next
    End If
    GetInstances = TRUE
End Function


Function ApplyFix(ByVal strInstance, ByVal strServerName)
    Err.Clear
    ON ERROR RESUME NEXT

    Dim objConn, objCmd, objCmd1, objRS, objRS1
    Dim strCommand, strConn
    Dim strBuildVersion, strProductLevel, bApplyFix

    ' Inicjowanie wartości zwracanej
    ApplyFix = FALSE

    strConn = "Provider=sqloledb;Initial Catalog=master;Integrated Security=SSPI;Data Source=" + strServerName + ";"
    ' Sprawdanie błędów zostało celowo pominięte, aby nie przedłużać kodu
    Set objConn = CreateObject("ADODB.Connection")
    Set objCmd = CreateObject("ADODB.Command")
    Set objCmd1 = CreateObject("ADODB.Command")

    ' Otwieranie połączenia z wzorcem bazy danych
    objConn.Open strConn 
    If ErrorOccurred("Błąd: nie można nawiązać połączenia z " + strInstance) Then
        Set objConn = Nothing
        Exit Function
    End If

    ' Sprawdzanie wersji przed zastosowaniem poprawki
    strCommand = "select SERVERPROPERTY('ProductVersion') as version, SERVERPROPERTY('productlevel') as productlevel"
    objCmd.ActiveConnection = objConn
    objCmd.CommandType = adCmdText
    objCmd.CommandText = strCommand

    Set objRS = objCmd.Execute()
    If ErrorOccurred("BŁĄD: nie można wykonać polecenia """ + strCommand + """ dla " + strInstance) = TRUE Then
        objConn.Close()
        Set objConn = Nothing
        ApplyFix = FALSE
        Exit Function   
    End If

    strBuildVersion = objRS("version")
    strProductLevel = UCase(objRS("productlevel"))

    bApplyFix = FALSE
    ' Zastosowanie obejścia tylko dla wersji SQL 2000 i SQL 2005 (RTM, SP1 i SP2)
    If (CInt(Mid(strBuildVersion,1,1)) = 8) Then
        bApplyFix = TRUE
    ElseIf CInt(Mid(strBuildVersion,1,1)) = 9 AND (StrComp(strProductLevel,"RTM") = 0 OR StrComp(strProductLevel,"SP1") = 0 OR StrComp(strProductLevel,"SP2") = 0) Then
        bApplyFix = TRUE
    End If 

    If bApplyFix = TRUE Then
        strCommand = "deny execute on sp_replwritetovarbin to public"
        objCmd1.ActiveConnection = objConn
        objCmd1.CommandType = adCmdText
        objCmd1.CommandText = strCommand
        Set objRS1 = objCmd1.Execute()
        If ErrorOccurred("BŁĄD: nie można wykonać polecenia """ + strCommand + """ dla " + strInstance) = FALSE Then
            WScript.Echo "INFORMACJA: pomyślnie zastosowano obejście dla wystąpienia " + strInstance + " (" + strBuildVersion + ")." + vbCRLF
            ApplyFix = TRUE
        End If
    Else
        WScript.Echo "INFORMACJA: pomijanie gromadzenia informacji dla wystąpienia " + strInstance + " (" + strBuildVersion + "), ponieważ nie dotyczy go problem." + vbCRLF
        ApplyFix = TRUE
    End If

    objConn.Close()
    Set objConn = Nothing
    Set objCmd = Nothing
    Set objCmd1 = Nothing
    Set objRS = Nothing
    Set objRS1 = Nothing
End Function

Private Function GetRegValue (ByVal strMachineName, ByVal hMainKey, ByVal strPath, ByVal strValueName, ByRef strValue, ByVal iValueType, ByVal b32bit)
    Err.Clear
    ON ERROR RESUME NEXT

    Dim objLocator, objServices, objRegistry, objCtx
    Dim sMultiStrings, lRc
    GetRegValue = TRUE

    'Połączenie z usługą WMI i pobranie obiektu do klasy STDREGPROV.
    Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
    If b32bit = TRUE Then
        objCtx.Add "__ProviderArchitecture", 32
    Else
        objCtx.Add "__ProviderArchitecture", 64
    End If
    objCtx.Add "__RequiredArchitecture", TRUE
    set objLocator = createobject("wbemscripting.swbemlocator")
    set objServices = objLocator.connectserver(strMachineName,DEFAULTNAMESPACE, "", "",,,,objCtx)
    set objRegistry = objServices.get(STDREGPROV)
    If ErrorOccurred("BŁĄD: nie można nawiązać połączenia z obszarem nazw WMI " + DEFAULTNAMESPACE) Then
        GetRegValue = FALSE
        Exit Function
    End If 

    lRc = 0
    Select Case iValueType
        ' Chodzi tylko o wartość REG_MULTI_SZ
        Case REG_MULTI_SZ
            strValue = ""
            lRC = objRegistry.GetMultiStringValue(hMainKey, strPath, strValueName, sMultiStrings)
            strValue = sMultiStrings
        Case REG_SZ
            strValue = ""
            lRC = objRegistry.GetStringValue(hMainKey, strPath, strValueName, strValue)
        Case Else
            GetRegValue = FALSE
    End Select

    If lRc = 2 Or lRc = 3 Then
        GetRegValue = TRUE
        strValue = ""
    ElseIf Err.Number OR lRc <> 0 Then
        GetRegValue = FALSE
    End If

    Set objLocator = Nothing
    Set objServices = Nothing
    Set objRegistry = Nothing
End Function

Function IsEmptyNull(sCheck)
    IsEmptyNull = FALSE
    If IsObject(sCheck) Then Exit Function
    If IsArray(sCheck) Then Exit Function
    If VarType(sCheck) = vbEmpty Then IsEmptyNull = TRUE : Exit Function
    If VarType(sCheck) = vbNull Then IsEmptyNull = TRUE : Exit Function
    If sCheck = "" Then IsEmptyNull = TRUE
End Function

Private Function ErrorOccurred (ByVal strIn)
    If Err.Number <> 0 Then
        WScript.Echo strIn
        WScript.Echo "BŁĄD: 0x" & Err.Number & " - " & Err.Description
        Err.Clear
        ErrorOccurred = TRUE
    Else
        ErrorOccurred = FALSE
    End If
End Function

Function IsOs64Bit()
    Err.Clear
    ON ERROR RESUME NEXT

    Dim objProc
    Set objProc = GetObject("winmgmts:root\cimv2:Win32_Processor='cpu0'")
    If objProc.Architecture = 0 Then
        IsOs64Bit = FALSE
    Else
        IsOs64Bit = TRUE
    End If
End Function

Function GetFullInstance (ByRef strInstanceName, ByVal b32bit)
    Err.Clear
    ON ERROR RESUME NEXT 

    Dim objServices, objClusters, objCluster
    Dim strMacName, isEmpty
    Dim strKey, strInstID

    GetFullInstance = TRUE

    If strComp(UCase(strInstanceName), "MICROSOFT##SSEE", 1) = 0 Then
        strInstanceName = "np:\\.\pipe\mssql$microsoft##ssee\sql\query"
        Exit Function
    End if

    strMacName = ""
    Set objServices = GetObject("winmgmts:root\cimv2")

    ' Query Cluster service
    Set objClusters = objServices.ExecQuery ("select * from win32_service where Name='ClusSvc' AND Started = TRUE")
    isEmpty = TRUE
    If Err.Number = 0 Then
        For each objCluster in objClusters
            isEmpty = FALSE
        Next
    End If

    Set objServices = Nothing
    Set objClusters = Nothing

    If isEmpty = TRUE Then
        strInstanceName = BuildInstanceName (".", strInstanceName)
        Exit Function
    End If

    ' Osiągnięcie tego miejsca oznacza, że komputer jest węzłem klastrowanym.
    ' Dlatego należy wykonać kwerendę w rejestrze sprawdzającą, czy wystąpienie programu SQL jest klastrowane.
    ' Dla wersji SQL 2000 kwerenda powinna dotyczyć następującej wartości:
    ' HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\<nazwa_wystąpienia>\Cluster
    ' ClusterName
    strKey = "SOFTWARE\Microsoft\Microsoft SQL Server\" + strInstanceName + "\Cluster"
    GetRegValue "", HKEY_LOCAL_MACHINE, strKey, "ClusterName", strMacName, REG_SZ, b32bit

    If StrComp(strMacName, "") <> 0 Then
        strInstanceName = BuildInstanceName (strMacName, strInstanceName)
        Exit Function
    End If

    strKey = "SOFTWARE\Microsoft\" + strInstanceName + "\Cluster"
    GetRegValue "", HKEY_LOCAL_MACHINE, strKey, "ClusterName", strMacName, REG_SZ, b32bit

    If StrComp(strMacName, "") <> 0 Then
        strInstanceName = BuildInstanceName (strMacName, strInstanceName)
        Exit Function
    End If

    ' Kwerenda zwracająca wartości rejestru dla wystąpień programu SQL 2005/2008
    'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\Instance Names\SQL
    ' RegValue = InstanceName
    strInstID = ""
    strKey = "SOFTWARE\Microsoft\Microsoft SQL Server\Instance Names\SQL"
    GetRegValue "", HKEY_LOCAL_MACHINE, strKey, strInstanceName, strInstID, REG_SZ, b32bit

    If StrComp(strInstID, "") = 0 Then
        ' Jeśli ten klucz nie istnieje, przyjmowane jest założenie, że jest to lokalne wystąpienie programu SQL 2000
        strInstanceName = BuildInstanceName (".", strInstanceName)
        Exit Function
    End If

    strKey = "SOFTWARE\Microsoft\Microsoft SQL Server\" + strInstID + "\Cluster"
    GetRegValue "", HKEY_LOCAL_MACHINE, strKey, "ClusterName", strMacName, REG_SZ, b32bit

    If StrComp(strMacName, "") = 0 Then
        strMacName = "."
    End If

    strInstanceName = BuildInstanceName (strMacName, strInstanceName)
End Function

Function BuildInstanceName (ByVal strMachineName, ByVal strInstanceName)
    Dim strPrefix

    strPrefix = ""
    If StrComp(strMachineName, ".") = 0 Then
        strPrefix = "lpc:"
    End If

    If strComp(UCase(strInstanceName), "MSSQLSERVER", 1) = 0 Then
        BuildInstanceName = strPrefix + strMachineName
    Else
        BuildInstanceName = strPrefix + strMachineName + "\" + strInstanceName
    End if
End Function