How to reject incoming mail according to Blacklist

[vawwjioa]

@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?

[jimimaseye]

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.

[vawwjioa]

Thank you very much!
I will test it

[vawwjioa]

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..

[jimimaseye]

Code: Select all

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