'!script
' ---------------------------------------------------------------------------
'  Copyright (C) 2009 PGP Corporation
'  All rights reserved.
'
'  Certificate provisioning script for PGP Command Line with KMS
'
'  $Id$
' ---------------------------------------------------------------------------

' --------------------------------------------------
' Config
' --------------------------------------------------
Option Explicit
Dim PGP,USP_SERVER,PGP_HOME,TEMPDIR,PREFS_FILE,HOSTNAMES,CERT_MIN_LIFETIME_DAYS,KEY_LENGTH,VERBOSE,DEBUG

USP_SERVER		= "keys.senderdomain.com"
HOSTNAMES 		= array("Default Web Site:www.senderdomain.com")
CERT_MIN_LIFETIME_DAYS	=2
KEY_LENGTH	= 2048
VERBOSE		= false
DEBUG		= false

PGP			= "pgp.exe"
PGP_HOME 	= "%APPDATA%\PGP Corporation\pgp_cert_provision"
TEMPDIR 	= PGP_HOME & "\tmp"
PREFS_FILE	= "%APPDATA%\PGP Corporation\PGP\PGPprefs.xml"

' --------------------------------------------------
' Required objects
' --------------------------------------------------
Dim WshShell,oFSO
Set WshShell = WScript.CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")

' --------------------------------------------------
' Utility functions
' --------------------------------------------------

function dprint(string)
    if DEBUG then wscript.echo string 
end function

function vprint(string)
	if VERBOSE then wscript.echo string 
end function

function lprint(string)
  wscript.echo string
end function

function callPgp(string)
	Dim strCall, strSTD, strERR, oExec
	strCall= PGP & " --homedir """ & PGP_HOME & """ " & string & ""
	Set oExec = WshShell.Exec(strCall)
	Do While oExec.Status = 0 
		If Not oExec.StdOut.AtEndOfStream Then
				strSTD = strSTD & oExec.StdOut.Read(1)
		End If
		If Not oExec.StdErr.AtEndOfStream Then
				strERR = strERR & oExec.StdErr.Read(1)
		End If
	Loop
	Do While oExec.Status = 0
		WScript.Sleep 100
	Loop
	If oExec.ExitCode <> 0 Then
		lprint "***pgp invocation failed!"
		lprint "Executed '" & strCall & "'"
		lprint "Exit status " & oExec.ExitCode
		lprint "------------------------------------------------------------"
		lprint "                    PGP Output:"
		lprint "------------------------------------------------------------"
		lprint strSTD & strERR
		lprint "------------------------------------------------------------"
		wscript.quit(oExec.ExitCode)
	else
		dprint "Executed '" & strCall & "'"
		dprint "------------------------------------------------------------"
		dprint "                    PGP Output:"
		dprint "------------------------------------------------------------"
		dprint strSTD & strERR
		dprint "------------------------------------------------------------"
	end if
	' return output from pgp.exe
	callPgp = strSTD & strERR
end function

Function regExMatch(strPattern, strText)
	Dim oRegEx, oMatch, oMatches   ' Create variable.
	Set oRegEx = New RegExp   ' Create a regular expression.
	oRegEx.Pattern = strPattern   ' Set pattern.
	oRegEx.IgnoreCase = True   ' Set case insensitivity.
	oRegEx.Global = False   ' Set global applicability.
	Set oMatches = oRegEx.Execute(strText)   ' Execute search.
	For Each oMatch in oMatches   ' Iterate Matches collection.
		if oMatch.SubMatches.Count > 0 then 
			regExMatch = oMatch.SubMatches(0)
			exit function
		End if
	Next
	regExMatch = false
End Function

Function reverseDNSLookup(ip)
	' since iis does not store the hostname in the config for ssl bindings, we have to get it using a reverse dns lookup
	dim strSTD, strERR, oExec, ret
	Set oExec = WshShell.Exec("nslookup -q=a " & ip)
	Do While oExec.Status = 0 
		If Not oExec.StdOut.AtEndOfStream Then
			strSTD = strSTD & oExec.StdOut.Read(1)
		End If
	Loop
	Do While oExec.Status = 0
		WScript.Sleep 100
	Loop
	If oExec.ExitCode <> 0 Then
		dprint " couldn't get hostname by reverse lookup"
		reverseDNSLookup = false
		exit function
	end if
	ret = regExMatch("Name:[ ]+(.*)",strSTD)
	if (ret <> false) then
		reverseDNSLookup = ret
	end if
End Function

' a virtual host class
class VirtualHost
	Private instanceName
	Private my_hostname
	Private my_is_hostname_guessed
	Private my_oCert
	Private oService
	Private oServer
	Private iis_hostname
	Private iis_instancename
	Private my_cert_file
	Private my_pfx_file
	Private my_pfx_available
	Private my_chain_file
	Private my_new_pfx
	
	' constructor
	Private Sub Class_Initialize
		oService = false
		my_oCert = false
		my_hostname = false
	End Sub
	
	' destructor
	Private Sub Class_Terminate
		If oFSO.FileExists(my_cert_file) Then oFSO.DeleteFile my_cert_file
		If oFSO.FileExists(my_pfx_file) Then oFSO.DeleteFile my_pfx_file
		If oFSO.FileExists(my_chain_file) Then oFSO.DeleteFile my_chain_file
		If oFSO.FileExists(my_new_pfx) Then oFSO.DeleteFile my_new_pfx
	End Sub

	' property access
	Public Property Get is_hostname_guessed
		is_hostname_guessed = my_is_hostname_guessed
	End Property
	
	Public Property Get hostname
		hostname = my_hostname
	End Property
	
	Public Property Get cert_file
		cert_file = my_cert_file
	End Property
	
	Public Property Get pfx_available
		pfx_available = my_pfx_available
	End Property
	
	Public Property Get pfx_file
		cert_file = my_pfx_file
	End Property
	
	Public Property Get isValid
		isValid = my_isValid
	End Property
	
	' utility functions
	Public Sub from_server_instance(host,instance)
		Dim found_server,oSrv
		found_server = false
		iis_hostname = host
		Set oService = GetObject( "IIS://" & host & "/" & "W3SVC" )
		For Each oSrv In oService
			' we will only work for Web Services and skip ftp etc
			If (oSrv.Class = "IIsWebServer") Then
				If (oSrv.Name = instance) Then
					Set oServer = oSrv
					iis_instancename = oSrv.Name
					found_server = true
				End If
			End If
		Next
		If (found_server = false) Then
			lprint "Couldn't find an instance with name '" & instance & "'! exiting"
			wscript.quit(1)
		End If
		' now initialize all vars
		instanceName = oServer.ServerComment
		get_instance_hostname
		init_oCert
		export_cert
		export_pfx
		export_chain
	End Sub
	
	Private Sub init_oCert
		set my_oCert = WScript.CreateObject("IIS.CertObj")
		my_oCert.ServerName = iis_hostname
		my_oCert.InstanceName = "W3SVC/" & iis_instancename
	End Sub

	Private Sub export_cert
		my_cert_file = TEMPDIR & "\iis_" & iis_instancename & "_pub.pfx"
		dprint "exporting crt to " & my_cert_file
		my_oCert.Export my_cert_file, iis_instancename, false, false, false
	End Sub
	
	Private Sub export_pfx
		my_pfx_file = TEMPDIR & "\iis_" & iis_instancename & "_priv.pfx"
		dprint "exporting pfx to " & my_pfx_file
		on error resume next
		my_oCert.Export my_pfx_file, iis_instancename,true, false, false
		If Err.Number <> 0 Then
			wscript.echo "Error: reported:'" & Err.Number & ":" & Err.Description & "'"
			If Err.Number = -2146893813 Then vprint " the private key is not exportable"
			my_pfx_available = false
		Else
			my_pfx_available = true
		End If
		on error goto 0
	End Sub
	
	Private Sub export_chain
		my_chain_file = TEMPDIR & "\iis_" & iis_instancename & "_chain.pfx"
		dprint "exporting chain to " & my_chain_file
		my_oCert.Export my_chain_file, iis_instancename, false, true, false
	End Sub
	
	Private Sub get_instance_hostname
		Dim entry, entr, ipaddress
		my_hostname = false
		my_is_hostname_guessed = true
		' this function returns the applicable instance's hostname
		for each entry in HOSTNAMES
			entr = split (entry,":")
			if (entr(0)=instanceName) Then
				my_hostname = entr(1)
				dprint " hostname configured in script: '" & my_hostname & "'"
				my_is_hostname_guessed = false
			end if
		next
		if (my_hostname = false) then
			vprint " consider adding the hostname to the script"
			' we didn't find a hostname, try option 2
			for each entry in oServer.ServerBindings
				entr = split (entry,":")
				ipaddress = entr(0)
				if (len(entr(2))> 3) then
					my_hostname = entr(2)
					vprint " hostname configured in unsecure binding: '" & my_hostname & "'"
				end if
			next
		end if
		if (my_hostname = false AND len(ipaddress) > 1) then
			' if we still didn't find a hostname, use a reverse dns lookup
			my_hostname = reverseDNSLookup(ipaddress)
			if (my_hostname <> false) then
				vprint " hostname found through reverse lookup to ip " & ipaddress & " :'" & my_hostname & "'"
			end if
		end if
		if (my_hostname = false) then
			' still didn't find any, so we use the local machines dns name
			my_hostname = WshShell.RegRead("HKLM\System\CurrentControlSet\Services\tcpip\parameters\hostname") &"." & WshShell.RegRead("HKLM\System\CurrentControlSet\Services\tcpip\parameters\domain")
			vprint " hostname found by using machines hostname from registry:'" & my_hostname & "'"
		End If
	End Sub
	
	Private Function check_certificate_chain
		dprint "check_certificate_chain not implemented, returning true"
		check_certificate_chain = true
	End Function
	
	Private Function my_isValid
		Dim time_found, retVal, str, cert_id, expiration, line
		if (not oFSO.FileExists(my_cert_file)) then
		  vprint "Cert file '" & my_cert_file & "' does not exist."
		  my_isValid = false
		  exit function
		end if
		
		' Import cert to check validity
		' depending on if we import a certificate or p12 file change the import command
		retVal = regExMatch(".*(\..{3})$",my_cert_file)
		if (retVal = ".pfx") then
			str = callPgp ("--import """ & my_cert_file & """ --wrapper-key --passphrase """ & iis_instancename & "")
		elseif (retVal = ".crt" OR retVal = ".cer") then
			str = callPgp ("--import """ & my_cert_file & """")
		else 
			lprint "Cannot parse file '" & my_cert_file & "' unknown file type"
			my_isValid = false
			exit function
		end if
		retVal = regExMatch("key imported as (0x[a-fA-F0-9]+)",str)

		if retVal <> false then
			cert_id = retVal
			dprint "Imported as '" & cert_id & "'"
		else
		  lprint "Failed to import certificate!"
		  wscript.quit(1)
		end if
		time_found = false
		expiration = callPgp( "--list-sig-details " & cert_id )
		for each line in split(expiration,vbCrLf)
			retVal = regExMatch("^[ \t]*Expires: " & "([0-9][0-9][0-9][0-9]-[01][0-9]-[0-3][0-9])[ \t]*$",line)
			if (retVal <> false AND isDate(retVal))then
				expiration = CDate(retVal)
				time_found = true
				lprint "Certificate for '" & my_hostname & "' will expire on '" & expiration & "'"
				if(expiration <= DateAdd("d",CERT_MIN_LIFETIME_DAYS,Date())) then
					lprint " Certificate valid for less than " & CERT_MIN_LIFETIME_DAYS & " days, renewing"
					my_isValid = false
					exit function
				end if
				lprint " Certificate will not be renewed"
			end if
		next
		
		if (time_found <> true) then
			lprint "Faild to get expiration time from signature details!"
			escript.quit(1)
		end if

		if(check_certificate_chain <> true) then
			vprint "Certificate chain is not valid\n"
			my_isValid = false
			exit function
		end if
		
		my_isValid = true
	End Function
	
	Public Function create_managed_cert
	' Cenerate new cert, and place the cert and the key files in their
	' corresponding location
	Dim line, key_id, retVal, uuid
		key_id = false
		' generate a topkey-only key
		line = callPgp ("--gen-key --passphrase """ & iis_instancename & """ --key-type rsa-sign-only --expiration-days 14 --bits " & KEY_LENGTH & " " & my_hostname & "")
		retVal = regExMatch("(0x[0-9A-F]+):generate key \(0:key successfully generated\).*",line)
		if (retVal <> false) then 
			key_id = retVal
		else
			lprint "*** Failed to generate key."
			create_managed_cert = false
			exit function
		End If
		' set all keyflags
		line = callPgp ("--set-key-flag --key-flag encrypt-and-sign " & key_id & " --passphrase """ & iis_instancename & """" )
		retVal = regExMatch("(0x[0-9A-F]+):set key flag \(0:flags updated successfully\).*",line)
		if (retVal = false) then 
			lprint "*** Failed to set key flags."
			create_managed_cert = false
			exit function
		End If
		if key_id <> false then
			dprint "Key id: " & key_id 
		else
			lprint "*** Failed to generate cert."
			create_managed_cert = false
			exit function
		end if
		' Export to file
		callPgp "--export --armor -o """ & TEMPDIR & "\" & my_hostname & ".pub.asc"" --overwrite remove " & key_id
		' Create MAK from public key
		line = callPgp ("--usp-server " & USP_SERVER & " --import-mak --name " &  my_hostname & " """ & TEMPDIR & "\" & my_hostname & ".pub.asc""")
		retVal = regExMatch("mported as ([^) ]+)",line)
		if retVal <> false then
			uuid = retVal
			dprint "Imported MAK as '" & uuid & "'"
		else
			create_managed_cert = false
			exit function
		end if
		' Export cert from USP server
		callPgp "--usp-server " & USP_SERVER & " --export-mak --export-format x509-cert -o """ & TEMPDIR & "\" & my_hostname & ".crt"" --overwrite remove " & uuid
		' Import cert into keyring, so we can convert it to pkcs #12
		callPgp "--import """ & TEMPDIR & "\" & my_hostname & ".crt"""
		callPgp "--export --export-format pkcs12 --passphrase """ & iis_instancename & """ --export-passphrase """ & iis_instancename & """ -o """ & TEMPDIR & "\" & my_hostname & ".pfx"" --overwrite remove " & key_id
		my_new_pfx =  TEMPDIR & "\" & my_hostname & ".pfx"
		' assign the new cert to the instance
		assign_new_cert
		create_managed_cert = true
	end function

	private sub assign_new_cert
		on error resume next
		my_oCert.ImportToCertStore my_new_pfx, iis_instancename, true, true
		my_oCert.Import my_new_pfx, iis_instancename, true, true
		If Err.Number <> 0 Then
			wscript.echo "Error: reported:'" & Err.Number & ":" & Err.Description & "'"
			If Err.Number = 5 Then wscript.echo " probably wrong pfx password"
			If Err.Number = 462 Then wscript.echo " probably server '" & IISServer & "' does not exist or cannot be reached"
			If Err.Number = -2147024894 Then wscript.echo " probably couldn't open pfx file"
			If Err.Number = -2147024893 Then wscript.echo " probably instance '" & ServerInstanceName & "' does not exist on server '" & IISServer & "'"
			wscript.quit 1
		End If
		on error goto 0
	end sub
end class ' VirtualHost

function init
	Dim mkdir_out,oFolder
	PGP_HOME = WshShell.ExpandEnvironmentStrings(PGP_HOME)
	TEMPDIR = WshShell.ExpandEnvironmentStrings(TEMPDIR)
	PREFS_FILE = WshShell.ExpandEnvironmentStrings(PREFS_FILE)
	' start with a cleanup
	cleanup
	on error resume next
	oFolder = oFSO.CreateFolder(PGP_HOME)
	if(Err.Number <> 0) then
		lprint "***error creating temporary PGP_HOME in '" & PGP_HOME & "':"
		lprint "Error: reported:'" & Err.Number & ":" & Err.Description & "'"
		lprint "Exiting.\n"
		wscript.quit(1)
	end if
	oFSO.CopyFile PREFS_FILE, PGP_HOME & "\PGPprefs.xml"
	if(Err.Number <> 0) then
		lprint "***error copying prefs file '" & PREFS_FILE & "' to '" & PGP_HOME & "':"
		lprint "Error: reported:'" & Err.Number & ":" & Err.Description & "'"
		lprint "Exiting.\n"
		wscript.quit(1)
	end if
	oFolder = oFSO.CreateFolder(TEMPDIR)
	if(Err.Number <> 0) then
		lprint "***error creating temporary TEMPDIR in '" & PGP_HOME & "':"
		lprint "Error: reported:'" & Err.Number & ":" & Err.Description & "'"
		lprint "Exiting.\n"
		wscript.quit(1)
	end if
	on error goto 0
	callPgp "--create-keyrings"
End Function

Function cleanup
	Dim oFolder
	If oFSO.FolderExists(WshShell.ExpandEnvironmentStrings(PGP_HOME)) then
		set oFolder = oFSO.GetFolder(WshShell.ExpandEnvironmentStrings(PGP_HOME))
		oFolder.Delete
	End If
End Function

Function get_iis_ssl_instances(host)
	' this function returns an array of all available instances of IIS on this computer
	Dim oServer, oService, oBind, has_ssl_binding, instance_names
	Set oService = GetObject( "IIS://" & host & "/" & "W3SVC" )
	instance_names = "" ' empty
	For Each oServer in oService
		If oServer.Class = "IIsWebServer" then
			has_ssl_binding = false
				For Each oBind in oServer.SecureBindings
					has_ssl_binding = true
				Next
			If (has_ssl_binding) Then
				dprint(" Found SSL enabled instance '" & oServer.Name & "' on server '" & host & "'")
				If (instance_names = "" ) Then
					instance_names = oServer.Name' the first entry
				Else
					instance_names = instance_names & ";" & oServer.Name ' following entries
				End If
			End If
		End If
	Next
	If (len(instance_names) > 0) Then
		' split the names and return an array
		get_iis_ssl_instances = split (instance_names, ";")
	Else
		' return false if we didn't find anything
		get_iis_ssl_instances = false
	End If
End Function

' main script runtime
Dim oVhost, arrInstances, strInstance, ret

' initialize temp dir
init

' get the list of all istances
arrInstances = get_iis_ssl_instances("localhost")

For Each strInstance in arrInstances
	dprint "checking instance '" & strInstance & "'"
	Set oVhost = new VirtualHost ' create object
	oVhost.from_server_instance "localhost", strInstance
	If (oVhost.isValid) Then
		vprint " Verified certificate on instance '" & oVhost.hostname & "'"
	Else
		oVhost.create_managed_cert
        lprint " Generated new certificate and key for '" & oVhost.hostname & "'"
	End If
Next

' cleanup
cleanup

wscript.quit(0)