' DDNS.VBS - Windows shell script to update dynamic dns hosted on DnsMadeEasy
'
' Author: Donn Bly @ DBLY Group, LLC - https://dbly.com
' License: The MIT License (MIT)
' =============================================================================
'
' Copyright (c) 2015-2016 DBLY Group, LLC [ https://dbly.com ]
'
' Permission is hereby granted, free of charge, to any person obtaining a copy
' of this software and associated documentation files (the "Software"), to deal
' in the Software without restriction, including without limitation the rights
' to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
' copies of the Software, and to permit persons to whom the Software is
' furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all
' copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
' OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
' SOFTWARE.
'
' =============================================================================
'
' Version History:
'
' Version 1.0.0 - Initial Release -  May 14, 2015
'
' Background:
'
' I ran into a situation where I wanted to utilize dynamic DNS for a client
' but every ddns update client I found for windows was either tied to a
' specific vendor that I didn't use, was adware supported, required a
' licence fee, or worse of all, required JAVA to run.
'
' I wasn't going to install java runtime on a server for just this function
' and I wasn't going to buy a license for such a trivial function. So, I
' decided to write my own.
'
' My Requirements:
'
' 1.  Use something already installed on a windows server by default
' 2.  Store authentication information in a config file and not hardcode anything
' 3.  limit network traffic and only update when necessary
' 4.  work with DnsMadeEasy, my anycast DNS provider of choice
' 5.  be lightweight enough to run as a windows service
' 6.  passwords need to be obfuscated and not stored in clear text
'
' Usage:
'
' Before using with DnsMadeEasy, you must first create the host record in the
' control panel, setting the Dynamic flag, and creating a record-specific
' password.  The control panel will generate the recordid which you will need
' to configure the script.  I HIGHLY RECOMMEND creating a unique password for
' the host record, and not using your own control panel password.
'
' By default the config file is stored in the same folder as the script, but
' the script allows you to specify the config file on the command line using
' the /config: command line switch.  This is useful if you want to store the
' config file in a folder other than the script, which you may wish to do
' because the config file is updated every time the script runs in order to
' keep track of the public ip and the last time it was verified.  From a
' security standpoint, especially if running as a scheduled task, you may
' wish to store the script in a secure folder where the user running it only
' has read-only access, and put the config file in a folder where only the
' user context in which the script is running has access.
'
' The other command line switches are only for initial configuration and are
' pretty much self-explanatory:
'
' /username:{username}   Your DnsMadeEasy Username
' /recordid:{recordid}   The Record ID for the dynamic host
' /password:{password}   The password for the dynamic host record.
'
' The switches update the config file, and the data is stored as a base-64
' encoded string (not plain text, but not overly secure - thus the recommendation
' of using the /config: switch for production use). Encryption of passwords is
' a worthless exercise for something that runs as a script.  It would be a
' trivial exercise to hack the decryption routine out of the script, or throw
' an echo statement to display the password after it has already been
' decrypted.  Please be secure and make use of the operating system's security
' to prevent unauthorized access to the script and config file.
'
' Version 1.0.1 - Maintenance Release -  July 5, 2015
'
' Changes to the DNS Made Easy API URL have required a maintenance release.
'
' To change the API URL, edit your ddns.config file and update the UrlWrite line
'
' Before:
'     UrlWrite=https://www.dnsmadeeasy.com/servlet/updateip
'
' After:
'     UrlWrite=https://cp.dnsmadeeasy.com/servlet/updateip
'
' No change to the script is necessary, but an updated version with the new URL 
' as default is available as version 1.0.1
'
' Version 1.0.2 - Maintenance Release -  July 6, 2015
'
' Changes to the DNS Made Easy API URL have required a maintenance release.
'
' To change the API URL, edit your ddns.config file and update the UrlWrite line
'
' Before:
'     UrlRead=http://www.dnsmadeeasy.com/myip.jsp
'
' After:
'     UrlRead=http://myip.dnsmadeeasy.com/
'
' No change to the script is necessary, but an updated version with the new URL 
' as default is available as version 1.0.2
'
' Version 1.0.3 - Maintenance Release -  August 24, 2016
'
' Changes to data returned by the the DNS Made Easy API URL have required a 
' maintenance release.
'
' We have observed the API intermitently returning whitespace in the form of 
' tabs and spaces after the IP address.  The updated script strips non IPv4
' characters before testing.

Option Explicit
Dim oConfig, sConfigFile, sCurrentIP, rc
Dim UpdateConfigFlag
Dim ConfigError
Public oFSO, oXMLHTTP, oShell

Const C_USERNAME = "eUsername"
Const C_PASSWORD = "ePassword"
Const C_RECORDID = "eRecordID"
Const C_URLREAD = "UrlRead"
Const C_URLWRITE = "UrlWrite"
Const C_PUBLICIP = "PublicIP"
Const C_LASTUPDATE = "LastUpdate"
Const C_LASTVERIFY = "LastVerify"
Const C_STATUS = "Status"
Const C_STATUS_ERROR_READ = "Error On Read"
Const C_STATUS_ERROR_UPDATE = "Error On Update"
Const C_STATUS_OK = "Ok"
Const C_CONFIG_FLAG = "[DBLYGROUP DDNS UPDATER "
Const C_CONFIG_SUFFIX = "v1.0.3]"

' While the default is to use Base64 Encoding, you can always replace the 
' following with something else for further obfuscation.  Just remember that 
' the first character is the padding character and the overall length of the 
' string must be 65 characters.

Const BASE64_TRANSLATION = "=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

UpdateConfigFlag = False
ConfigError = False

set oConfig = createobject("scripting.dictionary")
set oFSO = CreateObject("scripting.filesystemobject")
set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
set oShell = CreateObject("WScript.Shell")

' Set Up Default Configuration

sConfigFile = ".\ddns.config"

oConfig.Add C_USERNAME, ""
oConfig.Add C_PASSWORD, ""
oConfig.Add C_RECORDID, ""
oConfig.Add C_URLREAD, "http://myip.dnsmadeeasy.com/"
oConfig.Add C_URLWRITE, "https://cp.dnsmadeeasy.com/servlet/updateip"
oConfig.Add C_PUBLICIP, ""
oConfig.Add C_LASTUPDATE, ""
oConfig.Add C_LASTVERIFY, ""

' apply any command line overrides to the defaults

If WScript.Arguments.Named.Exists("config") Then
	sConfigFile = WScript.Arguments.Named.Item("config")
End If

if oFSO.FileExists(sConfigFile) then
	set oConfig = getConfigFile( sConfigFile, oConfig )
else
	UpdateConfigFlag = True
end if

If WScript.Arguments.Named.Exists("username") Then
	oConfig( C_USERNAME ) = WScript.Arguments.Named.Item("username")
	UpdateConfigFlag = True
End If

If WScript.Arguments.Named.Exists("password") Then
	oConfig( C_PASSWORD ) = WScript.Arguments.Named.Item("password")
	UpdateConfigFlag = True
End If

If WScript.Arguments.Named.Exists("recordid") Then
	oConfig( C_RECORDID ) = WScript.Arguments.Named.Item("recordid")
	UpdateConfigFlag = True
End If

If UpdateConfigFlag Then
	UpdateConfigFile sConfigFile, oConfig
	Wscript.StdOut.WriteLine "Config File Updated"
End If

if oConfig( C_USERNAME ) = "" Then
	LogError "ERROR: Username not specified.  Use /username:{username} to set"
	ConfigError = True
End If

if oConfig( C_PASSWORD ) = "" Then
	LogError "ERROR: Password not specified.  Use /password:{password} to set"
	ConfigError = True
End If

if oConfig( C_RECORDID ) = "" Then
	LogError "ERROR: RecordID not specified.  Use /recordid:{recordid} to set"
	ConfigError = True
End If

If ConfigError Then
	Wscript.Quit(1)
End If

sCurrentIP = GetCurrentPublicIP( oConfig( C_URLREAD ) )

if sCurrentIP = oConfig( C_PUBLICIP ) Then
	oConfig( C_LASTVERIFY ) = FormatDateTime(Now)
	oConfig.Add C_STATUS, C_STATUS_OK
elseif len( sCurrentIP ) Then
	rc = PutCurrentPublicIP( sCurrentIP, oConfig )
	if rc = 0 then
		oConfig( C_PUBLICIP ) = sCurrentIP
		oConfig( C_LASTUPDATE ) = FormatDateTime(Now)
		oConfig.Add C_STATUS, C_STATUS_OK
	Else
		oConfig.Add C_STATUS, C_STATUS_ERROR_UPDATE
	end if
Else
	oConfig.Add C_STATUS, C_STATUS_ERROR_READ
end if

UpdateConfigFile sConfigFile, oConfig

if oConfig( C_STATUS ) = C_STATUS_OK Then
	wscript.quit 0
Else
	wscript.quit 1
end if
	

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

Function getCurrentPublicIP( sUrlRead )
	' use an http request to determine the outside, public ip address.  Since
	' this script is designed around DnsMadeEasy, it defaults to their public
	' page.
	
	Dim IpRegex, sResponse, sReturn
	sReturn = ""
	Set IpRegex = New RegExp
	IpRegex.Pattern = "^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$"
	On Error Resume Next
	oXMLHTTP.Open "GET", sUrlRead, False
	oXMLHTTP.Send
	if oXMLHTTP.Status = 200 Then
		sResponse = oXMLHTTP.responseText
		IpRegex.Pattern = "[^0-9\.]"
		IpRegex.Global = True
		sResponse = IpRegex.Replace( sResponse, "" )
		IpRegex.Pattern = "^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$"
		if IpRegex.Test( sResponse ) Then
			sReturn = sResponse
			Wscript.StdOut.WriteLine "Public IP Address = " & sReturn
		Else
			LogError "Error Getting Public IP Address.  Response = [" & sResponse & "]"
		End If
	Else
		LogError "Error Getting Public IP Address.  Status = " & oXMLHTTP.Status
	End If
	getCurrentPublicIP = sReturn
End Function

Function PutCurrentPublicIP( sCurrentIP, oConfig )
	' update dns server with current ip address using an HTTPS GET request
	Dim sUrl, sResponse, lReturn
	sUrl = oConfig( C_URLWRITE ) _
		& "?username=" & oConfig( C_USERNAME ) _
		& "&password=" & oConfig( C_PASSWORD ) _
		& "&id=" & oConfig( C_RECORDID ) _
		& "&ip=" & sCurrentIP

	lReturn = 1
	On Error Resume Next
	oXMLHTTP.Open "GET", sUrl, False
	oXMLHTTP.Send
	if oXMLHTTP.Status = 200 Then
		sResponse = oXMLHTTP.responseText
		if sResponse = "success" Then
			lReturn = 0
		Else
			LogError "Error Setting Public IP Address.  Response = " & sResponse
		End If
	Else
		LogError "Error Setting Public IP Address.  Status = " & oXMLHTTP.Status
	End If
	PutCurrentPublicIP = lReturn
End Function

Function getConfigFile ( sConfigFile, oDefaultConfig )
	' read config file, return dictionary object
	Dim oFile, sKey, oNewConfig, sBuff, sValue, i
	set oNewConfig = CreateObject("scripting.dictionary")
	For Each sKey in oDefaultConfig.Keys
		oNewConfig.Add sKey, oDefaultConfig(sKey)
	Next
	set oFile = oFSO.OpenTextFile(sConfigFile,1)
	sBuff = oFile.ReadLine
	if left(sBuff,len( C_CONFIG_FLAG)) = C_CONFIG_FLAG Then
		Do Until oFile.AtEndOfStream
			sBuff = oFile.ReadLine
			sKey = ""
			sValue = ""
			i = instr(sBuff,"=") 
			if i then
				sKey = left(sBuff,i-1)
				sValue = mid(sBuff,i+1)
				' if key begins with a lower case "e" then we have encoded it
				if left(sKey,1) = "e" Then sValue = StringDecode(sValue)
			Else
				LogError "Unexpected Data: " & sBuff
			end if
			if len(sKey) Then
				if oNewConfig.Exists(sKey) Then
					oNewConfig(sKey) = sValue
				End If
			End If
		Loop
	Else
		LogError "Configuration File of Unexpected Format"
		Wscript.Quit(1)
	End If

	oFile.Close
	set getConfigFile = oNewConfig
End Function

Sub UpdateConfigFile( sConfigFile, oConfig )
	Dim oFile, sKey
	
	set oFile = oFSO.OpenTextFile(sConfigFile,2,true)
	oFile.WriteLine C_CONFIG_FLAG & C_CONFIG_SUFFIX
	For Each sKey in oConfig.Keys
		if left(sKey,1) = "e" Then
			oFile.WriteLine sKey & "=" & StringEncode(oConfig(sKey))
		Else
			oFile.WriteLine sKey & "=" & oConfig(sKey)
		End If
	Next
	oFile.Close
End Sub

Function StringDecode( sPayload )
	' Basic Base64 String Decode
	Dim sReturn, Padding, Segment, c, ch(3), sHex, sOut
	sReturn = ""
	if len(sPayload) Mod 4 Then
		LogError "Decode Error: " & sPayload
		Exit Function
	End If
	For Segment = 1 to Len(sPayload) Step 4
		Padding = 0
		For c = 0 to 3
			ch(c) = instr( BASE64_TRANSLATION, mid( sPayload, Segment + c, 1 ) ) - 2
			if ch(c) = -2 Then
				LogError "Decode Error, Offset " & cstr( Segment + c ) & " : " & sPayload
				Exit Function
			ElseIf ch(c) = -1 Then
				ch(c) = 0
				Padding = Padding + 1
			end if
		Next
		sHex = Right( "000000" & Hex( ch(3) + ch(2)*&h40 + ch(1)*&h1000 + ch(0)*&h40000 ), 6)
		sOut = Left(Chr(CByte("&h" & Mid(sHex, 1, 2))) & Chr(CByte("&h" & Mid(sHex, 3, 2))) & Chr(CByte("&h" & Mid(sHex, 5, 2))),3 - Padding)
		sReturn = sReturn & sOut
	Next
	StringDecode = sReturn
End Function

Function StringEncode( sPayload )
	' Basic Base64 String Encode
	Dim Segment, c, ch(2), vSeg, sOut, sReturn, LastBlock
	sReturn = ""
	For Segment = 1 to len(sPayload) step 3
		for c = 0 to 2
			if Segment+c <= Len(sPayload) Then
				ch(c) = asc(mid(sPayload, Segment + c, 1))
			Else
				ch(c) = 0
			End If
		next
		vSeg = ch(2) + ch(1)*&h100 + ch(0)*&h10000
		sOut = ""
		For c = 0 to 3
			sOut = mid( BASE64_TRANSLATION,(vSeg Mod 64) + 2,1) & sOut
			vSeg = vSeg \ 64
		Next
		sReturn = sReturn & sOut
	Next

	' if payload doesn't translate evenly into a 24 bit block, replace extras with padding character
	LastBlock = 3 - len(sPayload) mod 3
	if LastBlock <> 3 Then 
		sReturn = left(sReturn, len(sReturn) - LastBlock ) & string(LastBlock, Left( BASE64_TRANSLATION, 1 ))
	End If

	StringEncode = sReturn
End Function

Sub LogError( sNotice )
	Dim oShell
	set oShell = CreateObject("WScript.Shell")
	' 0 SUCCESS
	' 1 ERROR
	' 2 WARNING
	' 4 INFORMATION
	' 8 AUDIT_SUCCESS
	' 16 AUDIT_FAILURE	
	oShell.LogEvent 1, "[DDNS] " & sNotice
	Wscript.StdErr.WriteLine sNotice
End Sub