With respect to the IDS code I posted earlier. I have reduced the script footprint in hMailserver from previously quoted 241 lines of active code to 55 lines of code. Plus it's no longer using the AODB.Connection and all the extra API calls - so all in all it should speed things up with a factor 500 (or something to that effect
).
I use AutoBan in my script but it could just as well be code to add IP Addresses to a firewall.
The "handler" part is not yet finished, but from hMailServers perspective - the "handler" is irellevant wrt. performance as it is running outside hMailServer.
As long as the "handler" code can access the database (socket or IP), it can be written in whatever programming language you prefer.
Actually, if you use IPTables on a 'Nix Box, you can run the "handler" directly on the 'Nix Box and access the database across the LAN.
*** NEW ***
Code: Select all
'******************************************************************************************************************************
'********** hMailServer IDS Client Code (MySQL) **********
'******************************************************************************************************************************
Private Const idsTable = "hm_ids2"
' DRIVER={MySQL ODBC 5.3 Unicode Driver};Server=localhost;Port=3306;Database=%idsdb%;Uid=%idsuid%;Pwd=%idspwd%;Option=3;
'
' Table: CREATE TABLE %idsTable% (
' id INTEGER PRIMARY KEY AUTO_INCREMENT,
' timestamp DATETIME,
' ipaddress VARCHAR (192) UNIQUE,
' port INTEGER,
' hits INTEGER);
Function idsAddIP(sIPAddress, iPort)
Dim strSQL, oDB : Set oDB = GetDatabaseObject
strSQL = "INSERT IGNORE INTO " & idsTable & " (timestamp,ipaddress,port,hits) VALUES (NOW(),'" & sIPAddress & "'," & iPort & ",0);"
Call oDB.ExecuteSQL(strSQL)
strSQL = "UPDATE " & idsTable & " SET hits=(hits+1),timestamp=NOW() WHERE IPAddress='" & sIPAddress & "';"
Call oDB.ExecuteSQL(strSQL)
End Function
Function idsDelIP(sIPAddress)
Dim strSQL, oDB : Set oDB = GetDatabaseObject
strSQL = "DELETE FROM " & idsTable & " WHERE ipaddress = '" & sIPAddress & "';"
Call oDB.ExecuteSQL(strSQL)
End Function
'******************************************************************************************************************************
'********** hMailServer Triggers **********
'******************************************************************************************************************************
Sub OnClientConnect(oClient)
Dim strPort
' Only allow non-SMTP connect from "Rigsfællesskabet"/"Naalagaaffeqatigiit"/"Ríkisfelagsskapurin" = The Danish Realm.
' 000 = N/A, 208 = Denmark, 304 = Greenland, 234 = Faroe Islands
If (oClient.Port <> 25) Then
If InStr("|208|304|234|", NerdLookup(oClient.IPAddress)) = 0 Then
Call idsAddIP(oClient.IPAddress, oClient.Port)
Result.Value = 1
Exit Sub
End If
End If
' Only test SMTP traffic
If InStr("|25|587|465|", oClient.Port) > 0 Then
Call idsAddIP(oClient.IPAddress, 0)
End If
End Sub
Sub OnAcceptMessage(oClient, oMessage)
Call idsDelIP(oClient.IPAddress)
End Sub
*** OLD ***
Code: Select all
'******************************************************************************************************************************
'********** hMailServer IDS Code (MySQL) **********
'******************************************************************************************************************************
Private Const idsDBDrv = "DRIVER={MySQL ODBC 5.3 Unicode Driver};Database=#DB#;Uid=#UID#;Pwd=#PWD#;Option=3;"
Private Const idsTab01 = "hm_ids"
Private Const idsHit01 = 3
Private Const idsMins = 120
Private Const idsTab02 = "hm_portmon"
Private Const idsHit02 = 5
' DRIVER={MySQL ODBC 5.3 Unicode Driver};Server=localhost;Port=3306;Database=#DB#;Uid=#UID#;Pwd=#PWD#;Option=3;
' Table: CREATE TABLE %ids% (
' id INTEGER PRIMARY KEY AUTO_INCREMENT,
' timestamp DATETIME,
' ipaddress VARCHAR (192) UNIQUE,
' hits INTEGER);"
' Table: CREATE TABLE %portmon% (
' id INTEGER PRIMARY KEY AUTO_INCREMENT,
' timestamp DATETIME,
' ipaddress VARCHAR (192) UNIQUE,
' port INTEGER,
' hits INTEGER);"
Function idsDelete(sIPAddress)
Dim oConn : Set oConn = CreateObject("ADODB.Connection")
oConn.Open idsDBDrv
If oConn.State <> 1 Then
EventLog.Write( "idsDelete - ERROR: Could not connect" )
Exit Function
End If
oConn.Execute "DELETE FROM " & idsTab01 & " WHERE ipaddress = '" & sIPAddress & "';"
oConn.Close
End Function
Function idsCheck(sIPAddress) : idsCheck = False
Dim oRecord, oConn : Set oConn = CreateObject("ADODB.Connection")
oConn.Open idsDBDrv
If oConn.State <> 1 Then
EventLog.Write( "idsCheck - ERROR: Could not connect" )
Exit Function
End If
On Error Resume Next
Set oRecord = oConn.Execute("SELECT * FROM " & idsTab01 & " WHERE ipaddress='" & sIPAddress & "';")
On Error Goto 0
If Err.Number <> 0 Then
EventLog.Write( "idsCheck - ERROR: Table " & idsTab01 & " does not exist!" )
Exit Function
End If
If oRecord.BOF And oRecord.EOF Then ' IPAddress is NEW!
oConn.Execute "INSERT IGNORE INTO " & idsTab01 & " (timestamp,ipaddress,hits) VALUES (NOW(),'" & sIPAddress & "',0);"
oConn.Execute "UPDATE " & idsTab01 & " SET hits=(hits+1),timestamp=NOW() WHERE IPAddress='" & sIPAddress & "';"
Else ' In case of more than one record, unlikely since "ipaddress" have a UNIQUE constraint.
While Not oRecord.EOF
idsCheck = (oRecord("hits") >= idsHit01)
If (DateDiff("n", oRecord("timestamp"), Now()) > idsMins) Then ' IPAddress is known - but too old.
oConn.Execute "UPDATE " & idsTab01 & " SET hits=1,timestamp=NOW() WHERE IPAddress='" & sIPAddress & "';"
Else ' IPAddress is known - bump counter.
oConn.Execute "UPDATE " & idsTab01 & " SET hits=(hits+1),timestamp=NOW() WHERE IPAddress='" & sIPAddress & "';"
End If
oRecord.MoveNext
Wend
End If
oRecord.Close
oConn.Close
End Function
Function idsPortMon(sIPAddress, iPort) : idsPortMon = False
Dim oRecord, oConn : Set oConn = CreateObject("ADODB.Connection")
oConn.Open idsDBDrv
If oConn.State <> 1 Then
EventLog.Write( "idsPortMon - ERROR: Could not connect" )
Exit Function
End If
On Error Resume Next
Set oRecord = oConn.Execute("SELECT * FROM " & idsTab02 & " WHERE ipaddress='" & sIPAddress & "';")
On Error Goto 0
If Err.Number <> 0 Then
EventLog.Write( "idsPortMon - ERROR: Table " & idsTab02 & " does not exist!" )
Exit Function
End If
If oRecord.BOF And oRecord.EOF Then ' IPAddress is NEW!
oConn.Execute "INSERT IGNORE INTO " & idsTab02 & " (timestamp,ipaddress,port,hits) VALUES (NOW(),'" & sIPAddress & "'," & iPort & ",0);"
oConn.Execute "UPDATE " & idsTab02 & " SET hits=(hits+1),timestamp=NOW() WHERE IPAddress='" & sIPAddress & "';"
Else ' IPAddress is known - bump counter.
While Not oRecord.EOF
idsPortMon = (oRecord("hits") >= idsHit02)
oConn.Execute "UPDATE " & idsTab02 & " SET hits=(hits+1),timestamp=NOW() WHERE IPAddress='" & sIPAddress & "';"
oRecord.MoveNext
Wend
End If
oRecord.Close
oConn.Close
End Function
'******************************************************************************************************************************
'********** Functions **********
'******************************************************************************************************************************
Function Wait(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True
' .Run "sleep -m " & Int(sec * 1000), 0, True
' .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
End With
End Function
Function LockFile(strPath)
Const Append = 8
Const Unicode = -1
With CreateObject("Scripting.FileSystemObject")
Dim oFile, i
For i = 0 To 30
On Error Resume Next
Set oFile = .OpenTextFile(strPath, Append, True, Unicode)
If Not (Err.Number = 70) Then
Set LockFile = oFile
On Error Goto 0
Exit For
End If
On Error Goto 0
Wait(1)
Next
End With
If (Err.Number = 70) Then
EventLog.Write( "ERROR: EventHandlers.vbs" )
EventLog.Write( "File " & strPath & " is locked and timeout was exceeded." )
Err.Clear
ElseIf (Err.Number <> 0) Then
EventLog.Write( "ERROR: EventHandlers.vbs : Function LockFile" )
EventLog.Write( "Error : " & Err.Number )
EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
EventLog.Write( "Source : " & Err.Source )
EventLog.Write( "Description : " & Err.Description )
Err.Clear
End If
End Function
' System Scripting Runtime COM object ("SScripting.IPNetwork")
' http://www.netal.com/ssr.htm
' Binary -> http://www.netal.com/software/ssr15.zip
' http://countries.nerd.dk/isolist.txt
Function NerdLookup(strIP)
Dim a
a = Split(strIP, ".")
With CreateObject("SScripting.IPNetwork")
strIP = .DNSLookup(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".zz.countries.nerd.dk")
End With
If Left(strIP, 3) <> "127" Then
NerdLookup = "000"
Else
a = Split(strIP, ".")
NerdLookup = Right("00" & CStr(a(2)*256 + a(3)), 3)
End If
End Function
Function AutoBan(sIPAddress, sReason, iDuration, sType) : AutoBan = False
'
' sType can be one of the following;
' "yyyy" Year, "m" Month, "d" Day, "h" Hour, "n" Minute, "s" Second
'
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
With LockFile("c:\hmailserver\temp\autoban.lck")
On Error Resume Next
oApp.Settings.SecurityRanges.Refresh
If (oApp.Settings.SecurityRanges.ItemByName("(" & sReason & ") " & sIPAddress) Is Nothing) Then
With oApp.Settings.SecurityRanges.Add
.Name = "(" & sReason & ") " & sIPAddress
.LowerIP = sIPAddress
.UpperIP = sIPAddress
.Priority = 20
.Expires = True
.ExpiresTime = DateAdd(sType, iDuration, Now())
.Save
End With
AutoBan = True
End If
oApp.Settings.SecurityRanges.Refresh
On Error Goto 0
.Close
End With
End Function
'******************************************************************************************************************************
'********** hMailServer Triggers **********
'******************************************************************************************************************************
Sub OnClientConnect(oClient)
Dim strPort
' Only allow non-SMTP connect from "Rigsfællesskabet"/"Naalagaaffeqatigiit"/"Ríkisfelagsskapurin" = The Danish Realm.
' 000 = N/A, 208 = Denmark, 304 = Greenland, 234 = Faroe Islands
If (oClient.Port <> 25) Then
If InStr("|208|304|234|", NerdLookup(oClient.IPAddress)) = 0 Then
If idsPortMon(oClient.IPAddress, oClient.Port) Then
Result.Value = 1
strPort = Trim(Mid("SMTP IMAP SMTPSSUBM IMAPS", InStr("25 143 465 587 993 ", oClient.Port), 5))
If AutoBan(oClient.IPAddress, "PORTBLOCK - " & strPort, 1, "d") Then _
EventLog.Write( "AutoBan(" & oClient.IPAddress & ", PORTBLOCK - " & strPort & ", 1, d)" )
Exit Sub
Else
Result.Value = 1
Exit Sub
End If
End If
End If
' Only test SMTP traffic
If InStr("|25|587|465|", oClient.Port) > 0 Then
If idsCheck(oClient.IPAddress) Then
Result.Value = 1
If AutoBan(oClient.IPAddress, "IDS", 7, "d") Then _
EventLog.Write( "AutoBan(" & oClient.IPAddress & ", IDS, 7, d)" )
Exit Sub
End If
End If
End Sub
Sub OnAcceptMessage(oClient, oMessage)
' Cleanup IDS registry
idsDelete(oClient.IPAddress)
End Sub
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.