How to reject incoming mail according to Blacklist

This section contains scripts that hMailServer has contributed with. hMailServer 5 is needed to use these.
Post Reply
vawwjioa
New user
New user
Posts: 6
Joined: 2017-11-19 13:17

How to reject incoming mail according to Blacklist

Post by vawwjioa » 2017-11-21 21:21

@jimimaseye
Now it would be veeeery nice to have a blacklist rule for recieving mails from external adresses.
I dont have the skills to write such a script..
I think you only need some things in the blacklist for sending to external adresses, right?

User avatar
jimimaseye
Moderator
Moderator
Posts: 8070
Joined: 2011-09-08 17:48

Re: HOW TO: Allow or block some accounts sending external email

Post by jimimaseye » 2017-11-22 09:35

If you have antispam setup and using Spamassassin it already has a blacklist function that you can use (this is the easiest method and will also benefit from al the other feature of spamassassin too viewtopic.php?f=21&t=28133 )

From a script you will find some clues in here: viewtopic.php?f=20&t=29306

A rough cut (untested):

Code: Select all

Sub OnSMTPData(oClient, oMessage)
   If oClient.Username = "" Then
      Dim k, i, j, aUsername, oApp, oDomain, oDistributionList
      Set oApp = CreateObject("hMailServer.Application")
      Call oApp.Authenticate("Administrator", "*secret password*")
      For j = 0 To oMessage.Recipients.Count -1
         If oMessage.Recipients(j).IsLocalUser Then
            aUsername = Split(oClient.Username,"@")
            Set oDomain = oApp.Domains.ItemByName(aUsername(1))
            For k = 0 To oDomain.DistributionLists.Count -1
               If lcase(oDomain.DistributionLists.Item(k).Address) = lcase("Blacklist@" & aUsername(1)) Then
                  Set oDistributionList = oDomain.DistributionLists.Item(k)
                  if oDistributionList.Active then
                     For i = 0 To oDistributionList.Recipients.Count -1
                        If lcase(oDistributionList.Recipients.Item(i).RecipientAddress) = lcase(oMessage.fromaddress) Then
                           Result.Value = 2
                           Result.Message = "We dont like you."
                           Exit Sub
                        End If
                     Next
                  Exit For
                  End If
               End If
            Next
         End If
      Next
   End If
End Sub
Create a Distribution list called "Blacklist" in each domain and enter the from addresses that you went to reject from. (DONT let the existence of this list be known to your users!). If the from address of the email is found in any blacklist that belongs to the domain of any of the users the emial is destined for then the mail will be rejected outright.
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 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

vawwjioa
New user
New user
Posts: 6
Joined: 2017-11-19 13:17

Re: How to reject incoming mail according to Blacklist

Post by vawwjioa » 2017-11-26 13:25

Thank you very much!
I will test it

vawwjioa
New user
New user
Posts: 6
Joined: 2017-11-19 13:17

Re: How to reject incoming mail according to Blacklist

Post by vawwjioa » 2017-11-26 14:21

It doesnt work for me..
My whole Sub OnSMTPData(oClient, oMessage) looks like that:
(I use the NonSenders Script which works fine :-) )

Code: Select all

Sub OnSMTPData(oClient, oMessage)
   If oClient.Username <> "" and instr(oClient.Username, "@") > 0  Then
      Dim k, i, j, aUsername, oApp, oDomain, oDistributionList
      Set oApp = CreateObject("hMailServer.Application")
      Call oApp.Authenticate("Administrator", "*********")
      aUsername = Split(oClient.Username,"@")
      Set oDomain = oApp.Domains.ItemByName(aUsername(1))
      For k = 0 To oDomain.DistributionLists.Count -1
         If lcase(oDomain.DistributionLists.Item(k).Address) = lcase("NonSenders@" & aUsername(1)) Then
            Set oDistributionList = oDomain.DistributionLists.Item(k)
            if oDistributionList.Active then
               For j = 0 To oMessage.Recipients.Count -1
                  If (Not oMessage.Recipients(j).IsLocalUser) Then
                     For i = 0 To oDistributionList.Recipients.Count -1
                        If lcase(oDistributionList.Recipients.Item(i).RecipientAddress) = lcase(oClient.Username) Then
                           Result.Value = 2
                           Result.Message = "You are only allowed to send internally"
						   EventLog.Write(oClient.Username+" hat probiert eine externe Nachricht zu versenden. Dies wurde unterbunden.")
                           Exit Sub
                        End If
                     Next
                  End If
               Next
            End If
            Exit For
         End If
      Next
   End If
   
   If oClient.Username = "" Then
      Dim k, i, j, aUsername, oApp, oDomain, oDistributionList
      Set oApp = CreateObject("hMailServer.Application")
      Call oApp.Authenticate("Administrator", "*********")
      For j = 0 To oMessage.Recipients.Count -1
         If oMessage.Recipients(j).IsLocalUser Then
            aUsername = Split(oClient.Username,"@")
            Set oDomain = oApp.Domains.ItemByName(aUsername(1))
            For k = 0 To oDomain.DistributionLists.Count -1
               If lcase(oDomain.DistributionLists.Item(k).Address) = lcase("NonRecievers@" & aUsername(1)) Then
                  Set oDistributionList = oDomain.DistributionLists.Item(k)
                  if oDistributionList.Active then
                     For i = 0 To oDistributionList.Recipients.Count -1
                        If lcase(oDistributionList.Recipients.Item(i).RecipientAddress) = lcase(oMessage.fromaddress) Then
                           Result.Value = 2
                           Result.Message = "We dont like you."
                           Exit Sub
                        End If
                     Next
                  Exit For
                  End If
               End If
            Next
         End If
      Next
   End If
	
End Sub
First of all i get this error Message when i check the Syntax:

Code: Select all

"ERROR"	4236	"2017-11-26 13:08:42.951"	"Script Error: Source: Microsoft VBScript compilation error - Error: 800A0411 - Description: Name redefined - Line: 37 Column: 10 - Code:       Dim k, i, j, aUsername, oApp, oDomain, oDistributionList"
So i changed k to k2 , i to i2 and so on.
so my script look like that now:

Code: Select all

Sub OnSMTPData(oClient, oMessage)
   If oClient.Username <> "" and instr(oClient.Username, "@") > 0  Then
      Dim k, i, j, aUsername, oApp, oDomain, oDistributionList
      Set oApp = CreateObject("hMailServer.Application")
      Call oApp.Authenticate("Administrator", "*********")
      aUsername = Split(oClient.Username,"@")
      Set oDomain = oApp.Domains.ItemByName(aUsername(1))
      For k = 0 To oDomain.DistributionLists.Count -1
         If lcase(oDomain.DistributionLists.Item(k).Address) = lcase("NonSenders@" & aUsername(1)) Then
            Set oDistributionList = oDomain.DistributionLists.Item(k)
            if oDistributionList.Active then
               For j = 0 To oMessage.Recipients.Count -1
                  If (Not oMessage.Recipients(j).IsLocalUser) Then
                     For i = 0 To oDistributionList.Recipients.Count -1
                        If lcase(oDistributionList.Recipients.Item(i).RecipientAddress) = lcase(oClient.Username) Then
                           Result.Value = 2
                           Result.Message = "You are only allowed to send internally"
						   EventLog.Write(oClient.Username+" hat probiert eine externe Nachricht zu versenden. Dies wurde unterbunden.")
                           Exit Sub
                        End If
                     Next
                  End If
               Next
            End If
            Exit For
         End If
      Next
   End If
   
   If oClient.Username = "" Then
      Dim k2, i2, j2, aUsername2, oApp2, oDomain2, oDistributionList2
      Set oApp2 = CreateObject("hMailServer.Application")
      Call oApp2.Authenticate("Administrator", "*********")
      For j2 = 0 To oMessage.Recipients.Count -1
         If oMessage.Recipients(j2).IsLocalUser Then
            aUsername2 = Split(oClient.Username,"@")
            Set oDomain2 = oApp2.Domains.ItemByName(aUsername2(1))
            For k2 = 0 To oDomain2.DistributionLists.Count -1
               If lcase(oDomain2.DistributionLists.Item(k2).Address) = lcase("NonRecievers@" & aUsername2(1)) Then
                  Set oDistributionList2 = oDomain2.DistributionLists.Item(k2)
                  if oDistributionList2.Active then
                     For i2 = 0 To oDistributionList2.Recipients.Count -1
                        If lcase(oDistributionList2.Recipients.Item(i2).RecipientAddress) = lcase(oMessage.fromaddress) Then
                           Result.Value = 2
                           Result.Message = "We dont like you."
                           Exit Sub
                        End If
                     Next
                  Exit For
                  End If
               End If
            Next
         End If
      Next
   End If
	
End Sub
Now the Syntax Check is ok.
But The Script doesnt work..

If i send a Mail from one external account to my test account that is in the distribution list "NonRecievers@" the mail arrives and i get this error:

Code: Select all

"ERROR"	2280	"2017-11-26 13:16:45.350"	"Script Error: Source: Microsoft VBScript runtime error - Error: 800A0009 - Description: Subscript out of range: '[number: 1]' - Line: 43 Column: 12 - Code: (null)"
Line 43 is this one:

Code: Select all

            Set oDomain2 = oApp2.Domains.ItemByName(aUsername2(1))
And I think this error occours because in Line 42

Code: Select all

            aUsername2 = Split(oClient.Username,"@")
It should not split the oClient.Username but the address of the recipient, right??
But it have no idea how to solve this..

User avatar
jimimaseye
Moderator
Moderator
Posts: 8070
Joined: 2011-09-08 17:48

Re: How to reject incoming mail according to Blacklist

Post by jimimaseye » 2017-11-26 15:06

[code]Sub OnSMTPData(oClient, oMessage)
Dim k, i, j, aUsername, oApp, oDomain, oDistributionList
If oClient.Username <> "" and instr(oClient.Username, "@") > 0 Then
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "*********")
aUsername = Split(oClient.Username,"@")
Set oDomain = oApp.Domains.ItemByName(aUsername(1))
For k = 0 To oDomain.DistributionLists.Count -1
If lcase(oDomain.DistributionLists.Item(k).Address) = lcase("NonSenders@" & aUsername(1)) Then
Set oDistributionList = oDomain.DistributionLists.Item(k)
if oDistributionList.Active then
For j = 0 To oMessage.Recipients.Count -1
If (Not oMessage.Recipients(j).IsLocalUser) Then
For i = 0 To oDistributionList.Recipients.Count -1
If lcase(oDistributionList.Recipients.Item(i).RecipientAddress) = lcase(oClient.Username) Then
Result.Value = 2
Result.Message = "You are only allowed to send internally"
EventLog.Write(oClient.Username+" hat probiert eine externe Nachricht zu versenden. Dies wurde unterbunden.")
Exit Sub
End If
Next
End If
Next
End If
Exit For
End If
Next
End If

If oClient.Username = "" Then
For j = 0 To oMessage.Recipients.Count -1
If oMessage.Recipients(j).IsLocalUser Then
aUsername = Split(oMessage.Recipients(j).address,"@")
Set oDomain = oApp.Domains.ItemByName(aUsername(1))
For k = 0 To oDomain.DistributionLists.Count -1
If lcase(oDomain.DistributionLists.Item(k).Address) = lcase("NonRecievers@" & aUsername(1)) Then
Set oDistributionList = oDomain.DistributionLists.Item(k)
if oDistributionList.Active then
For i = 0 To oDistributionList.Recipients.Count -1
If lcase(oDistributionList.Recipients.Item(i).RecipientAddress) = lcase(oMessage.fromaddress) Then
Result.Value = 2
Result.Message = "We dont like you."
Exit Sub
End If
Next
Exit For
End If
End If
Next
End If
Next
End If

End Sub[/code]
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 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

Post Reply