This section contains scripts that hMailServer has contributed with. hMailServer 5 is needed to use these.
-
percepts
- Senior user

- Posts: 5282
- Joined: 2009-10-20 16:33
- Location: Sceptred Isle
Post
by percepts » 2014-09-02 18:04
Add following code to your Eventhandlers.vbs file in OnClientConnect so you have as follows:
Code: Select all
Sub OnClientConnect(oClient)
Dim IP
IP = oClient.IPAddress
Select Case IP
Case _
"1.1.1.1" _
,"2.2.2.2" _
,"3.3.3.3" _
Result.Value = 1
EventLog.Write ("Blacklist IP blocked: " & IP )
End Select
End Sub
For each IP you want to block, just duplicate last IP line and overtype with latest IP to block.
Don't forget to Reload Scripts in hMailAdmin for it to become effective.
-
glenluo
- Normal user

- Posts: 194
- Joined: 2011-07-03 12:10
Post
by glenluo » 2014-09-20 09:10
Can use below to block single IP or IP range
Code: Select all
Sub OnClientConnect(oClient)
Const BadIPGroup ="220.246.55.*|220.247.*.*|220.248.*.*|183.13.*.*"
If IsForbidIP(BadIPGroup) = True Then
Result.Value = 2
Result.Message = "IP in blacklist,server rejected!"
End If
End Sub
Function IsForbidIP(vBadIP)
Dim counter, arrIPPart, arrBadIP, arrBadIPPart, i, j
arrBadIP = Split(vBadIP, "|")
arrIPPart = Split(oClient.IPAddress,".")
For i = 0 To UBound(arrBadIP)
counter = 0
arrBadIPPart = Split(arrBadIP(i),".")
For j = 0 To UBound(arrIPPart)
If(arrBadIPPart(j)) = "*" or Cstr(arrIPPart(j)) = Cstr(arrBadIPPart(j)) Then
counter = counter + 1
End If
Next
If counter = 4 Then
IsForbidIP = True
Exit Function
End If
Next
IsForbidIP = False
End Function
-
LesD
- Senior user

- Posts: 343
- Joined: 2009-01-15 20:22
- Location: London, UK.
Post
by LesD » 2017-07-17 10:20
Is that value 2 above not a mistake?
The documentation defines values 0 and 1 only.
-
jimimaseye
- Moderator

- Posts: 8854
- Joined: 2011-09-08 17:48
Post
by jimimaseye » 2017-07-17 10:40
LesD wrote:
Is that value 2 above not a mistake?
The documentation defines values 0 and 1 only.
Correct. Its accept or reject only.
(At the time of 'connect' no smtp conversation has commenced and so there is no possible way of giving an explanation for rejection).
5.7 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829
-
LesD
- Senior user

- Posts: 343
- Joined: 2009-01-15 20:22
- Location: London, UK.
Post
by LesD » 2017-07-18 06:43
jimimaseye wrote:(At the time of 'connect' no smtp conversation has commenced and so there is no possible way of giving an explanation for rejection).
How is that? Surely hMS does not just disconnect. It must issue a 5xx message or similar so I would expect my 'message' to be added.
-
RvdH
- Senior user

- Posts: 1157
- Joined: 2008-06-27 14:42
- Location: Netherlands
Post
by RvdH » 2017-07-18 08:29
LesD wrote:jimimaseye wrote:(At the time of 'connect' no smtp conversation has commenced and so there is no possible way of giving an explanation for rejection).
How is that? Surely hMS does not just disconnect. It must issue a 5xx message or similar so I would expect my 'message' to be added.
Why 'must' it issue a 5xx message or similar?
https://www.hmailserver.com/documentati ... entconnect
CIDR to RegEx: d-fault.nl/CIDRtoRegEx
DNS Lookup: d-fault.nl/DNSTools
DNSBL Lookup: d-fault.nl/DNSBLLookup
GEOIP Lookup: d-fault.nl/GeoipLookup
-
LesD
- Senior user

- Posts: 343
- Joined: 2009-01-15 20:22
- Location: London, UK.
Post
by LesD » 2017-07-18 15:36
I just thought it was 'the done thing' but you are of course right.....
I have written my own routine based on the above examples and tested it by putting in my own IP and indeed the connection was unceremoniously dropped. - Thunderbird was most upset about it!
I will post the code shortly but want to run it a bit longer just in case of problems.
I have read some other threads on this topic and have seen mention of using DNSBL for the blocking so I tried setting up a private one on one of my own domains and it was very simple!
So now I am not sure which way to go. The DNSBL is much more elegant and does not require any fiddling with code (much safer) while updating the DNS is a bit more long winded (have to log into my domain registrar's account, find the domain and add a record to the DNS.)
(Most elegant and convenient would be a Blacklist facility iwithn hMS but I have seen that Martin is not keen on including it).
-
LesD
- Senior user

- Posts: 343
- Joined: 2009-01-15 20:22
- Location: London, UK.
Post
by LesD » 2017-07-21 12:29
Here is my code. It has been running for a few days and I tested it by putting in my own IP.
Code: Select all
Sub OnClientConnect(oClient)
' Check current connection IP against list. Returns true if IP is banned
If IsBadIP(BadIP,oClient) Then
Result.Value = 1 ' 0 = accept connection; 1 = reject
EventLog.Write "Client IP " & oClient.IPAddress & " rejected. Part of blacklist range " & BadIP
Exit Sub
End If
Result.Value = 0 ' 0 = accept connection; 1 = reject
End Sub
Function IsBadIP(BadIP,oClient)
' BadIP: Returns IP range to which the client IP matches
' Add IP or IP range below using separator: |
' Each block is defined as either a single IP or the last lart can be defined as a range
' e.g. 67.212.82.1|67.212.82.98-102
' 67.212.82.98-102=search engine registration
Const BadIPList ="67.212.82.98-102"
Dim aIPClientParts, IPClientInt, aBadIPList, aBadIPPart, aBadIPRange, IntStart, IntEnd, i
' Split up blacklist into individual IP values
aBadIPList = Split(BadIPList, "|")
' Split up client IP into 4 parts and convert to integer value
aIPClientParts = Split(oClient.IPAddress,".")
IPClientInt = IPtoInt(aIPClientParts(0), aIPClientParts(1), aIPClientParts(2), aIPClientParts(3))
' Now process each bad IP value (or range)
For i = 0 To UBound(aBadIPList)
' Split blacklisted IP into 4 parts
aBadIPParts = Split(aBadIPList(i),".")
' The 4th part (index 3) could be a single number or a range in the form nnn-mmm
' so try and split it
aBadIPRange = Split(aBadIPParts(3),"-")
' Define Start and End IPs:
' If there is no range then define both the same
if UBound(aBadIPRange) = 0 then
' Convert IP parts to long integer
IntStart = IPtoInt(aBadIPParts(0), aBadIPParts(1), aBadIPParts(2), aBadIPParts(3))
IntEnd = IntStart
else
' There is a range - start and end differ
IntStart = IPtoInt(aBadIPParts(0), aBadIPParts(1), aBadIPParts(2), aBadIPRange(0))
IntEnd = IPtoInt(aBadIPParts(0), aBadIPParts(1), aBadIPParts(2), aBadIPRange(1))
end if
' Is client IP within the range?
if IPClientInt >= IntStart and IPClientInt <= IntEnd then
IsBadIP = True
' Return IP range in which found
BadIP = aBadIPList(i)
Exit Function
End If
' IP is not in range
Next
' All OK
IsBadIP = False
BadIP = ""
End Function
Function IPtoInt(IP0, IP1, IP2, IP3)
Dim arrIPClient
' Convert 4 parts to integer
IPtoInt = IP3 + IP2*256 + IP1*256*256 + IP0*256*256*256
'WriteLog "IPtoInt", "IPaddress=" & IP0 & "." & IP1 & "." & IP2 & "." & IP3 & " Int=" & IPtoInt
End Function
-
RvdH
- Senior user

- Posts: 1157
- Joined: 2008-06-27 14:42
- Location: Netherlands
Post
by RvdH » 2017-07-21 12:47
Guess this can be made faster (regex) and simplified...check my signature for IpRangeRegex generator
Code: Select all
Sub OnClientConnect(oClient)
Dim strRegEx
strRegEx="^67\.212\.82\.(9[8-9])$|" &_
"^67\.212\.82\.(1(0[0-1]))$|" &_
"^67\.212\.82\.102$"
If Lookup(strRegEx, oClient.IPAddress) Then
Result.Value = 1
End if
End Sub
Function Lookup(strRegEx, strMatch)
With CreateObject("VBScript.RegExp")
.Global = False
.Pattern = strRegEx
.IgnoreCase = True
Lookup = .Test(strMatch)
End With
End Function
CIDR to RegEx: d-fault.nl/CIDRtoRegEx
DNS Lookup: d-fault.nl/DNSTools
DNSBL Lookup: d-fault.nl/DNSBLLookup
GEOIP Lookup: d-fault.nl/GeoipLookup
-
SorenR
- Senior user

- Posts: 4044
- Joined: 2006-08-21 15:38
- Location: Denmark
Post
by SorenR » 2017-08-02 15:48
Never thought the day would come... I'm now officially spamlisting Symantec...
Code: Select all
"SMTPD" 1472 4038 "2017-08-02 08:04:59.115" "216.82.251.13" "SENT: 220 mx.acme.inc ESMTP"
"SMTPD" 1472 4038 "2017-08-02 08:04:59.318" "216.82.251.13" "RECEIVED: EHLO mail1.bemta12.messagelabs.com"
"SMTPD" 1472 4038 "2017-08-02 08:04:59.334" "216.82.251.13" "SENT: 250-mx.acme.inc[nl]250 SIZE"
"SMTPD" 1472 4038 "2017-08-02 08:04:59.537" "216.82.251.13" "RECEIVED: MAIL FROM:<heifner.deleon@grupobimbo.com>"
"SMTPD" 1472 0 "2017-08-02 08:04:59.537" "TCP" "DNS lookup: 13.251.82.216.zen.spamhaus.org, 0 addresses found: (none), Match: False"
"SMTPD" 1472 0 "2017-08-02 08:04:59.537" "TCP" "DNS lookup: 13.251.82.216.b.barracudacentral.org, 0 addresses found: (none), Match: False"
"SMTPD" 1472 0 "2017-08-02 08:04:59.537" "TCP" "DNS lookup: 13.251.82.216.bl.spamcop.net, 0 addresses found: (none), Match: False"
"SMTPD" 1472 4038 "2017-08-02 08:05:00.537" "216.82.251.13" "SENT: 250 OK"
"SMTPD" 1472 4038 "2017-08-02 08:05:00.740" "216.82.251.13" "RECEIVED: RCPT TO:<louise@acme.inc>"
"SMTPD" 1472 4038 "2017-08-02 08:05:00.740" "216.82.251.13" "SENT: 250 OK"
"SMTPD" 1472 4038 "2017-08-02 08:05:00.943" "216.82.251.13" "RECEIVED: DATA"
"SMTPD" 1472 4038 "2017-08-02 08:05:00.959" "216.82.251.13" "SENT: 354 OK, send."
"SMTPD" 3972 4038 "2017-08-02 08:05:03.865" "216.82.251.13" "SENT: 250 Queued (2.875 seconds)"
"SMTPD" 3128 4038 "2017-08-02 08:05:09.068" "216.82.251.13" "RECEIVED: QUIT"
"SMTPD" 3128 4038 "2017-08-02 08:05:09.068" "216.82.251.13" "SENT: 221 goodbye"
"SMTPD" 1472 4040 "2017-08-02 08:05:24.131" "216.82.251.6" "SENT: 220 mx.acme.inc ESMTP"
"SMTPD" 1472 4040 "2017-08-02 08:05:24.334" "216.82.251.6" "RECEIVED: EHLO mail1.bemta12.messagelabs.com"
"SMTPD" 1472 4040 "2017-08-02 08:05:24.334" "216.82.251.6" "SENT: 250-mx.acme.inc[nl]250 SIZE"
"SMTPD" 1472 4040 "2017-08-02 08:05:24.537" "216.82.251.6" "RECEIVED: MAIL FROM:<heifner.deleon@grupobimbo.com>"
"SMTPD" 1472 0 "2017-08-02 08:05:24.537" "TCP" "DNS lookup: 6.251.82.216.zen.spamhaus.org, 0 addresses found: (none), Match: False"
"SMTPD" 1472 0 "2017-08-02 08:05:24.537" "TCP" "DNS lookup: 6.251.82.216.b.barracudacentral.org, 0 addresses found: (none), Match: False"
"SMTPD" 1472 0 "2017-08-02 08:05:24.537" "TCP" "DNS lookup: 6.251.82.216.bl.spamcop.net, 0 addresses found: (none), Match: False"
"SMTPD" 1472 4040 "2017-08-02 08:05:24.553" "216.82.251.6" "SENT: 250 OK"
"SMTPD" 1472 4040 "2017-08-02 08:05:24.741" "216.82.251.6" "RECEIVED: RCPT TO:<louise@acme.inc>"
"SMTPD" 1472 4040 "2017-08-02 08:05:24.756" "216.82.251.6" "SENT: 250 OK"
"SMTPD" 1472 4040 "2017-08-02 08:05:24.944" "216.82.251.6" "RECEIVED: DATA"
"SMTPD" 1472 4040 "2017-08-02 08:05:24.959" "216.82.251.6" "SENT: 354 OK, send."
"SMTPD" 3972 4040 "2017-08-02 08:05:26.537" "216.82.251.6" "SENT: 250 Queued (1.547 seconds)"
"SMTPD" 3892 4040 "2017-08-02 08:05:31.741" "216.82.251.6" "RECEIVED: QUIT"
"SMTPD" 3892 4040 "2017-08-02 08:05:31.741" "216.82.251.6" "SENT: 221 goodbye"
MessageLabs Inc. : 216.82.240.0 - 216.82.255.255
RegEx: ^216\.82\.(2(4[0-9]|5[0-5]))\.([0-9]|[1-9][0-9]|1([0-9][0-9])|2([0-4][0-9]|5[0-5]))$
http://www.analyticsmarket.com/freetools/ipregex
Yes, my daughter is currently blonde, but that does not justify this domain... "@grupobimbo.com" ... Hmm...
Code: Select all
Sub OnAcceptMessage(oClient, oMessage)
'
' More code ...
'
If Not (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
'
' 216.82.240.0 - 216.82.255.255 = MessageLabs Inc. (Symantec Inc.)
'
strRegEx = "^216\.82\.(2(4[0-9]|5[0-5]))\.([0-9]|[1-9][0-9]|1([0-9][0-9])|2([0-4][0-9]|5[0-5]))$"
If Lookup(strRegEx, oClient.IPAddress) Then Call SPAMList(oMessage)
End If
'
' More code ...
'
End Sub
Function Lookup(strRegEx, strMatch)
With CreateObject("VBScript.RegExp")
.Global = False
.Pattern = strRegEx
.IgnoreCase = True
Lookup = .Test(strMatch)
End With
End Function
Sub SPAMList(oMessage)
oMessage.HeaderValue("X-hMailServer-Spam") = "YES"
oMessage.HeaderValue("X-hMailServer-Reason-0") = "SPAMlisted - (Score: 5)"
oMessage.HeaderValue("X-hMailServer-Reason-Score") = 5
oMessage.Save
End Sub
SørenR.
Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.
-
RvdH
- Senior user

- Posts: 1157
- Joined: 2008-06-27 14:42
- Location: Netherlands
Post
by RvdH » 2017-08-02 16:22
CIDR to RegEx: d-fault.nl/CIDRtoRegEx
DNS Lookup: d-fault.nl/DNSTools
DNSBL Lookup: d-fault.nl/DNSBLLookup
GEOIP Lookup: d-fault.nl/GeoipLookup
-
SorenR
- Senior user

- Posts: 4044
- Joined: 2006-08-21 15:38
- Location: Denmark
Post
by SorenR » 2017-08-02 17:53
Nah...
Symantec.Core (MessageLabs) sending me SPAM is like the police trying to sell me a stolen car ...

SørenR.
Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.
-
RvdH
- Senior user

- Posts: 1157
- Joined: 2008-06-27 14:42
- Location: Netherlands
Post
by RvdH » 2017-08-02 19:04
SorenR wrote:
Nah...
Symantec.Core (MessageLabs) sending me SPAM is like the police trying to sell me a stolen car ...

lol, if you look at it like that i have to say you are right

CIDR to RegEx: d-fault.nl/CIDRtoRegEx
DNS Lookup: d-fault.nl/DNSTools
DNSBL Lookup: d-fault.nl/DNSBLLookup
GEOIP Lookup: d-fault.nl/GeoipLookup