'----------------------------------------------------------------------
'    ConfigureRQSForISA.vbs
'    RQS installation utility for Microsoft ISA Server 2004
'
'    Usage: 
'       To install: cscript ConfigureRQSForISA.vbs /install AllowedSet RqsToolsPath
'       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"
'
'
'    Copyright (c) Microsoft Corporation 
'    All Rights Reserved
'----------------------------------------------------------------------
'
' 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"
fpcRegInstPath = "HKLM\SOFTWARE\Microsoft\FPC\InstallDirectory"
RegServicePath="HKLM\System\CurrentControlSet\Services\Rqs"
RegEventPath="HKLM\System\CurrentControlSet\Services\EventLog\Application\Rqs"
ServiceName="Remote Access Quarantine Agent"
fpcRqsProtocolName = "RQS"
fpcRqsRuleName = "Network Quarantine (RQS)"
'
' Check parameters
'
If wscript.Arguments.Count < 1 then
    ShowHelp ""
Else
    cmdLine = LCase(wscript.Arguments(0))
    If cmdLine = "/install" Then
        If wscript.Arguments.Count <> 3 then
            ShowHelp "Invalid number of arguments"
        Else
            InstallRQS wscript.Arguments(1), wscript.Arguments(2)
        End If
    ElseIf cmdLine = "/remove" Then
        If wscript.Arguments.Count <> 1 then
            ShowHelp "Invalid number of arguments"
        Else
            RemoveRQS
        End If
    Else
        ShowHelp "Invalid argument"
    End If
End If

'
' Installtion function.
' Accepts AllowedSet string and path to RQS binaries.
'
Sub InstallRQS (AllowedSet, rqsToolsPath)
    if Len(AllowedSet) = 0 then 
        EchoError "You must specify the AllowedSet parameter"
        Exit Sub
    end if

    if Len(rqsToolsPath) = 0 then 
        EchoError "You must specify an RQS tools path argument"
        Exit Sub
    end if
    
    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 type= interact start= auto error= normal DisplayName= ""Network Quarantine Service""", 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 "Adding the allowed version strings under " & RegServicePath & "..."
    RunProgram "REG ADD " & RegServicePath & " /v AllowedSet /t REG_MULTI_SZ /d " & AllowedSet & " /f", false

    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

    EchoMessage "Looking for ISA installation path..."
    fpcInstPath = WshShell.RegRead(fpcRegInstPath)
    If Len(fpcInstPath) = 0 Then
        EchoError "Cannot detect ISA Server installation path. You must configure ISA Server firewall policy after you run this script"
        Exit Sub
    End If

    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 fpcRoot = CreateObject("FPC.Root")
    Set fpcArray = fpcRoot.GetContainingArray
    Set fpcProtocols = fpcArray.RuleElements.ProtocolDefinitions
    Set fpcPolicy = fpcArray.ArrayPolicy.PolicyRules

    EchoMessage "Adding RQS protocol definition..."
    set fpcRQS = fpcProtocols.Add(fpcRqsProtocolName)
    fpcRQS.Description = "Network Quarantine (RQS) protocol"
    fpcRQS.PrimaryConnections.AddTCP 1, 7250, 7250

    EchoMessage "Creating RQS access rule:" & vbCrLf & _
	            "  - from Quarantined VPN clients and VPN Clients" & vbCrLf & _
	            "  - to local host" & vbCrLf & _
    	        "  - protocol = " & fpcRqsProtocolName

    set fpcAllowRQSRule = fpcPolicy.AddAccessRule(fpcRqsRuleName)
    fpcAllowRQSRule.Action = 0
    fpcAllowRQSRule.Description = "Allow Network Quarantine traffic from roaming clients"
    fpcAllowRQSRule.AccessProperties.ProtocolSelectionMethod = 1 ' specified protocols
    fpcAllowRQSRule.AccessProperties.SpecifiedProtocols.Add "RQS", 0
    fpcAllowRQSRule.AccessProperties.DestinationSelectionIPs.Networks.Add "Local host", 0
    fpcAllowRQSRule.AccessProperties.UserSets.Add "All Users", 0
    fpcAllowRQSRule.SourceSelectionIPs.Networks.Add "VPN Clients", 0
    fpcAllowRQSRule.SourceSelectionIPs.Networks.Add "Quarantined VPN Clients", 0

    fpcArray.Save

    EchoMessage "Starting the RQS service..."
    RunProgram "net start rqs", false
    EchoMessage "The script successfully installed RQS for ISA Server 2004."
End Sub

'
' Removal function.
'
Sub RemoveRQS
    EchoMessage "Stopping RQS..."
    RunProgram "net stop rqs", false

    EchoMessage "Delete the RQS service..."
    RunProgram "sc delete rqs", true

    EchoMessage "Removing entries for the event log messages..."
    RunProgram "REG DELETE " & RegEventPath & " /f", false

    EchoMessage "Updating firewall policy..."
    Set fpcRoot = CreateObject("FPC.Root")
    Set fpcArray = fpcRoot.GetContainingArray
    Set fpcProtocols = fpcArray.RuleElements.ProtocolDefinitions
    Set fpcPolicy = fpcArray.ArrayPolicy.PolicyRules

    EchoMessage "Removing " & fpcRqsRuleName & " access rule..."
    On Error Resume Next
    
    fpcPolicy.Remove fpcRqsRuleName
    If Err.number <> 0 then 
		EchoError "Failed to remove RQS rule (" & fpcRqsRuleName & "): " & Err.Description
		Err.Clear
	End if

    EchoMessage "Removing " & fpcRqsProtocolName & " protocol definition..."
    fpcProtocols.Remove fpcRqsProtocolName
    If Err.number <> 0 then 
		EchoError "Failed to remove " & fpcRqsProtocolName & " protocol definition: " & Err.Description
		Err.Clear
	End if

	On Error Goto 0
	
    fpcArray.Save
    EchoMessage "The script successfully removed RQS for ISA Server 2004."
End Sub
'
' Error handling and usage help function
'
Sub ShowHelp(errMsg)
    Msg = "RQS installation utility for Microsoft ISA Server 2004" & vbCrLf & _
	      "======================================================" & vbCrLf & _
          "To install: cscript " & WScript.ScriptName & " /install AllowedSet RqsToolsPath" & vbCrLf & _
          "To remove:  cscript " & WScript.ScriptName & " /remove" & vbCrLf & _
          "" & vbCrLf & _
          "    where AllowedSet contains version strings separated by \0" & vbCrLf & _
          "" & vbCrLf & _
          "For example: " & vbCrLf & _
          "    cscript " & WScript.ScriptName & " /install SharedKey1\0SharedKey2 ""C:\Program Files\Rqs""" & vbCrLf 
    
    if Len(errMsg) <> 0 then
		Msg = Msg & vbCrLf & errMsg
    End if
    
    EchoMessage Msg    
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