''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright (c) Microsoft Corporation. All rights reserved.
' THIS CODE IS MADE AVAILABLE AS IS, WITHOUT WARRANTY OF ANY KIND. THE ENTIRE
' RISK OF THE USE OR THE RESULTS FROM THE USE OF THIS CODE REMAINS WITH THE
' USER. USE AND REDISTRIBUTION OF THIS CODE, WITH OR WITHOUT MODIFICATION, IS
' HEREBY PERMITTED.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'----------------------------------------------------------------------
' ConfigureRQSForISA-fr2.vbs [tout est dans le 2 ;-)]
' Remote Access Quarantine Service configuration utility for Microsoft ISA Server 2004
' Version localisée pour ISA Server 2004 en français par Stanislas Quastana
' Ce script correspond à la version US disponible à l adresse suivante:
' http://www.microsoft.com/downloads/details.aspx?FamilyID=17897522-AB69-46E0-9860-E2D9EC8CA122&displaylang=en
' Ce script est fourni en l état et ne confère aucun droit.
'
'
' Windows 2003 RTM usage:
' To install: cscript ConfigureRQSForISA.vbs /install AllowedSet RqsToolsPath
' To remove: cscript ConfigureRQSForISA.vbs /remove
'
' Windows 2003 Service Pack 1 or later usage:
' To install: cscript ConfigureRQSForISA.vbs /install AllowedSet
' To remove: cscript ConfigureRQSForISA.vbs /remove
'
' AllowedSet contains version strings separated by \0.
'
' For example:
' cscript ConfigureRQSForISA.vbs /install SharedKey1\0SharedKey2 "C:\Program Files\Rqs"
'
' On Windows 2003 Service Pack 1 or later, please install the Remote Access Quarantine Service component before running this script.
' You can install it from:
' Control Panel
' Add or Remove Programs
' Add/Remove Windows Components
' Networking Services
' Remote Access Quarantine Service
'
' Copyright (c) Microsoft Corporation
' All Rights Reserved
'----------------------------------------------------------------------
'-----------------------------------------------------------------------
'
' BEGIN LOCALIZATION
'
'-----------------------------------------------------------------------
fpcRqsRuleName = "Remote Access Quarantine (RQS)"
fpcRqsRuleDescription = "Autorise le trafic pour la quarantaine depuis les postes VPN nomades"
fpcRqsRuleProtocol = "RQS"
fpcLocalHostName = "Hôte local"
fpcAllUsers = "Tous les utilisateurs"
fpcVpnClientsNetworkName = "Clients VPN"
fpcQuarantinedVpnClientsNetworkName = "Clients VPN en quarantaine"
'-----------------------------------------------------------------------
'
' END LOCALIZATION
'
'-----------------------------------------------------------------------
'
' Create base system and shell objects
'
Set WshShell = CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("PROCESS")
Set FSO = CreateObject("Scripting.FileSystemObject")
'
' Define strings and paths in advance
'
vpnplginDllName = "vpnplgin.dll"
RegServicePath="HKLM\System\CurrentControlSet\Services\Rqs"
RegEventPath="HKLM\System\CurrentControlSet\Services\EventLog\Application\Rqs"
RqsServiceName="Remote Access Quarantine Agent"
fpcRqsProtocolName = "RQS"
Const ERR_ALREADY_EXISTS = &H800700B7
Const ERR_NOT_FOUND = &H80070002
'
' Check parameters
'
RqsIsPartOfOS = CheckIfRqsIsPartOfOS
If wscript.Arguments.Count < 1 then
ShowHelp "", RqsIsPartOfOS
Else
cmdLine = LCase(wscript.Arguments(0))
If cmdLine = "/install" Then
If RqsIsPartOfOS Then
If wscript.Arguments.Count <> 2 then
ShowHelp "Invalid number of arguments", RqsIsPartOfOS
Else
InstallRQS RqsIsPartOfOS, wscript.Arguments(1), ""
End If
Else
If wscript.Arguments.Count <> 3 then
ShowHelp "Invalid number of arguments", RqsIsPartOfOS
Else
InstallRQS RqsIsPartOfOS, wscript.Arguments(1), wscript.Arguments(2)
End If
End If
ElseIf cmdLine = "/remove" Then
If wscript.Arguments.Count <> 1 then
ShowHelp "Invalid number of arguments", RqsIsPartOfOS
Else
RemoveRQS RqsIsPartOfOS
End If
Else
ShowHelp "Invalid argument", RqsIsPartOfOS
End If
End If
'
' Error handling and usage help function
'
Sub ShowHelp(errMsg, RqsIsPartOfOS)
Msg = "Remote Access Quarantine Servce configuration utility" & vbCrLf & _
"for Microsoft ISA Server 2004" & vbCrLf & _
"" & vbCrLf & _
"Usage:" & vbCrLf
If Not RqsIsPartOfOS Then
Msg = Msg & _
" To install: cscript ConfigureRQSForISA.vbs /install AllowedSet RqsToolsPath" & vbCrLf & _
" To remove: cscript ConfigureRQSForISA.vbs /remove" & vbCrLf & _
"" & vbCrLf
Else
Msg = Msg & _
" To install: cscript ConfigureRQSForISA.vbs /install AllowedSet" & vbCrLf & _
" To remove: cscript ConfigureRQSForISA.vbs /remove" & vbCrLf & _
"" & vbCrLf
End If
Msg = Msg & _
"Notes: " & vbCrLf & _
" * AllowedSet contains version strings separated by \0." & vbCrLf
If RqsIsPartOfOS Then
Msg = Msg & _
" * On Windows 2003 Service Pack 1 or later, please install the Remote Access Quarantine Service" & vbCrLf & _
" component before running this script. You can install it from:" & vbCrLf & _
" Control Panel" & vbCrLf & _
" Add/Remove Programs" & vbCrLf & _
" Add/Remove Windows Components" & vbCrLf & _
" Networking Services" & vbCrLf & _
" Remote Access Quarantine Service" & vbCrLf
End If
Msg = Msg & _
"" & vbCrLf & _
"Examples:" & vbCrLf & _
" cscript ConfigureRQSForISA.vbs /install Key1\0Key2 ""C:\Program Files\Rqs""" & vbCrLf & _
"" & vbCrLf
if Len(errMsg) <> 0 then
Msg = Msg & vbCrFl & errMsg
End if
EchoMessage Msg
End Sub
'
' Installtion function.
' Accepts AllowedSet string and path to RQS binaries.
'
Sub InstallRQS (RqsIsPartOfOS, AllowedSet, rqsToolsPath)
if Len(AllowedSet) = 0 then
EchoError "You must specify the AllowedSet parameter"
Exit Sub
end if
If Not RqsIsPartOfOS Then
if Len(rqsToolsPath) = 0 then
EchoError "You must specify an RQS tools path argument"
Exit Sub
end if
End If
EchoMessage "Looking for ISA installation path..."
On Error Resume Next
Set fpcRoot = CreateObject("FPC.Root")
fpcError = Err.Number
fpcErrorMsg = Err.Description
If fpcError = 0 Then
fpcInstPath = fpcRoot.GetContainingServer.InstallationDirectory
fpcError = Err.Number
fpcErrorMsg = Err.Description
End If
On Error Goto 0
If fpcError <> 0 Then
EchoError "Microsoft ISA Server 2004 Firewall Service installation path cannot be detected: (" & fpcError & ") " & fpcErrorMsg
Exit Sub
End If
If Not RqsIsPartOfOS Then
rqsPath = FSO.BuildPath(rqsToolsPath, "Rqs.exe")
If Not FSO.FileExists(rqsPath) Then
EchoError "File not found: " & rqsPath
Exit Sub
End If
rqsMsgPath = FSO.BuildPath(rqsToolsPath, "RqsMsg.dll")
If Not FSO.FileExists(rqsMsgPath) Then
EchoError "File not found: " & rqsMsgPath
Exit Sub
End If
rqsPath = FSO.GetAbsolutePathName(rqsPath)
rqsMsgPath = FSO.GetAbsolutePathName(rqsMsgPath)
Set rqsDrive = FSO.GetDrive(FSO.GetDriveName(rqsPath))
If (rqsDrive.DriveType <> 2) Then
'
' Not a fixed disk
'
EchoError "RQS service can only be installed from a fixed drive - please copy RQS binaries to a fixed drive"
Exit Sub
End If
EchoMessage "Registering RQS as Service..."
RunProgram "sc create RQS binPath= """ & rqsPath & """ type= own depend= remoteaccess start= auto error= normal DisplayName= """ & RqsServiceName & """", true
RunProgram "sc description RQS ""This service can be used to implement a Quarantined VPN Clients network for a Routing and Remote Access Server""", true
RunProgram "sc failure RQS reset= 86400 actions= restart/0/restart/0", true
EchoMessage "Setting entries for the event log messages..."
RunProgram "REG ADD " & RegEventPath & " /v EventMessageFile /t REG_EXPAND_SZ /d """ & rqsMsgPath & """ /f", false
RunProgram "REG ADD " & RegEventPath & " /v TypesSupported /t REG_DWORD /d 7" & " /f", false
Else
rqsPath = FSO.BuildPath(WshSysEnv("SystemRoot"), "System32\Rqs.exe")
If Not FSO.FileExists(rqsPath) Then
EchoError "Remote Access Quarantine Service is not installed. Please install it first (see help notes)."
Exit Sub
End If
EchoMessage "Configuring RQS service to start automaticaly..."
RunProgram "sc config RQS start= auto", true
End If
EchoMessage "Adding the allowed version strings under " & RegServicePath & "..."
RunProgram "REG ADD " & RegServicePath & " /v AllowedSet /t REG_MULTI_SZ /d " & AllowedSet & " /f", false
EchoMessage "Setting RQS Authenticator value under " & RegServicePath & "..."
RunProgram "REG ADD " & RegServicePath & " /v Authenticator /t REG_SZ /d """ & FSO.BuildPath(fpcInstPath, vpnplginDllName) & """ /f", false
EchoMessage "Updating firewall policy..."
Set fpcArray = fpcRoot.GetContainingArray
Set fpcProtocols = fpcArray.RuleElements.ProtocolDefinitions
Set fpcPolicy = fpcArray.ArrayPolicy.PolicyRules
fpcChanged = false
EchoMessage "Adding RQS protocol definition..."
On Error Resume Next
set fpcRQS = fpcProtocols.Add(fpcRqsProtocolName)
fpcError = Err.Number
fpcErrorMsg = Err.Description
On Error Goto 0
If fpcError = 0 Then
fpcRQS.Description = "Remote Access Quarantine (RQS) protocol"
fpcRQS.PrimaryConnections.AddTCP 1, 7250, 7250
fpcChanged = true
ElseIf fpcError = ERR_ALREADY_EXISTS Then
EchoMessage "RQS protocol definition already exists"
Err.Clear
Else
EchoError "Failed to add RQS protocol definition: (" & fpcError & ") " & fpcErrorMsg
Exit Sub
End If
EchoMessage "Creating RQS access rule:" & vbCrLf & _
" - from Quarantined VPN clients and VPN Clients" & vbCrLf & _
" - to local host" & vbCrLf & _
" - protocol = " & fpcRqsProtocolName
On Error Resume Next
set fpcAllowRQSRule = fpcPolicy.AddAccessRule(fpcRqsRuleName)
fpcError = Err.Number
fpcErrorMsg = Err.Description
On Error Goto 0
If fpcError = 0 Then
fpcAllowRQSRule.Action = 0
fpcAllowRQSRule.Description = fpcRqsRuleDescription
fpcAllowRQSRule.AccessProperties.ProtocolSelectionMethod = 1 ' specified protocols
fpcAllowRQSRule.AccessProperties.SpecifiedProtocols.Add fpcRqsRuleProtocol, 0
fpcAllowRQSRule.AccessProperties.DestinationSelectionIPs.Networks.Add fpcLocalHostName, 0
fpcAllowRQSRule.AccessProperties.UserSets.Add fpcAllUsers, 0
fpcAllowRQSRule.SourceSelectionIPs.Networks.Add fpcVpnClientsNetworkName, 0
fpcAllowRQSRule.SourceSelectionIPs.Networks.Add fpcQuarantinedVpnClientsNetworkName, 0
fpcChanged = true
ElseIf fpcError = ERR_ALREADY_EXISTS Then
EchoMessage "RQS access rule already exists"
Err.Clear
Else
EchoError "Failed to add RQS access rule: (" & fpcError & ") " & fpcErrorMsg
Exit Sub
End If
If fpcChanged Then
EchoMessage "Saving configuration to the storage..."
fpcArray.Save
End If
EchoMessage "Starting the RQS service..."
RunProgram "net start rqs", false
EchoMessage "The script successfully configured RQS for ISA Server 2004."
End Sub
'
' Removal function.
'
Sub RemoveRQS (RqsIsPartOfOS)
EchoMessage "Stopping RQS..."
RunProgram "net stop rqs", false
If Not RqsIsPartOfOS Then
EchoMessage "Delete the RQS service..."
RunProgram "sc delete rqs", true
EchoMessage "Removing entries for the event log messages..."
RunProgram "REG DELETE " & RegEventPath & " /f", false
End If
EchoMessage "Updating firewall policy..."
Set fpcRoot = CreateObject("FPC.Root")
Set fpcArray = fpcRoot.GetContainingArray
Set fpcProtocols = fpcArray.RuleElements.ProtocolDefinitions
Set fpcPolicy = fpcArray.ArrayPolicy.PolicyRules
fpcChanged = false
EchoMessage "Removing " & fpcRqsRuleName & " access rule..."
On Error Resume Next
fpcPolicy.Remove fpcRqsRuleName
fpcError = Err.Number
fpcErrorMsg = Err.Description
On Error Goto 0
If fpcError <> 0 then
If fpcError <> ERR_NOT_FOUND Then
EchoError "Failed to remove RQS rule " & fpcRqsRuleName & ": (" & fpcError & ") " & fpcErrorMsg
End If
Err.Clear
Else
fpcChanged = true
End if
EchoMessage "Removing " & fpcRqsProtocolName & " protocol definition..."
On Error Resume Next
fpcProtocols.Remove fpcRqsProtocolName
fpcError = Err.Number
fpcErrorMsg = Err.Description
On Error Goto 0
If fpcError <> 0 Then
If fpcError <> ERR_NOT_FOUND Then
EchoError "Failed to remove " & fpcRqsProtocolName & " protocol definition: (" & fpcError & ") " & fpcErrorMsg
End If
Err.Clear
Else
fpcChanged = true
End if
If fpcChanged Then
EchoMessage "Saving configuration to the storage..."
fpcArray.Save
End If
EchoMessage "The script successfully removed RQS for ISA Server 2004."
End Sub
'
' Utility function to execute a command
'
Function RunProgram(cmdLine, showStdOut)
Set oExec = WshShell.Exec(cmdLine)
Do While oExec.Status = 0
WScript.Sleep 100
Loop
If (showStdOut) Then
If Not oExec.StdOut.AtEndOfStream Then
WScript.echo oExec.StdOut.ReadAll
Exit Function
End If
End If
If Not oExec.StdErr.AtEndOfStream Then
WScript.echo oExec.StdErr.ReadAll
Exit Function
End If
RunProgram = oExec.ExitCode
End Function
Sub EchoMessage (Msg)
WScript.Echo Msg
End Sub
Sub EchoError (errMsg)
WScript.Echo "ERROR: " & errMsg
End Sub
Function CheckIfRqsIsPartOfOS
Dim ServicePackVersion
Dim OsVersion
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystems
ServicePackVersion = objOperatingSystem.ServicePackMajorVersion
OsVersion = objOperatingSystem.Version
Next
If Left(OsVersion, 3) = "5.2" Then
If ServicePackVersion >= 1 Then
CheckIfRqsIsPartOfOS = True
Else
CheckIfRqsIsPartOfOS = False
End If
Else
CheckIfRqsIsPartOfOS = False
End If
End Function
