Automatic Recipient Whitelisting

This section contains scripts that hMailServer has contributed with. hMailServer 5 is needed to use these.
Post Reply
percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Automatic Recipient Whitelisting

Post by percepts » 2016-03-11 23:24

How to auto whitelist recipients you send email to.

These two scripts have been placed here to make them easier to get at and replace the two scripts at end of following topic.

viewtopic.php?p=155678#p155678

These two scripts are for the purpose of whitelisting any recipients that you send email to. The main benefit is that it allows any external incoming email address that you have sent email, to bypass greylisting when they send their first mail to you and are not dependant on their mail servers smtp retry period which can delay you from receiving their email quickly. i.e. if you need a mail from someone external quickly and you are running greylisting, then just send them an email they can respond to and it should get through to you on their first attempt without being bounced with a 451 temporary failure message to them..

Note: script will only whitelist them to send to your user sending address and not to any other user at your own domain.

Auto Whitelist
The potential downsides to this script are, firstly it may quickly build a very large whitelist if you are sending to hundreds or more recipients. And secondly because it has to trawl through the full whitelist to check if the address is already in list(no method available to read by email address), it will become slow if the list grows to hundreds or more entries. But then again, it isn't using any external files with open and closes which slows down hMail. There is a cleanup script below so whitelist size can be managed to not grow too big with dormant entries.
Also no Spam checking on anything in whitelist, i.e. when you send to anyone then anything they send to you is not spam checked.

I did quick testing and it seems to work fine with gmail address I tested with greylisting switched on. i.e. it created whitelist and then it let gmail address straight through.

Place code in your onAcceptMessage Sub (in eventhandlers vbs) and set your admin password in code. Save and reload scripts. It's as simple as that.

Code: Select all

'--------------------------------------------------------
' Auto Whitelist recipients from auth'd senders
'--------------------------------------------------------
If oClient.Port = 25 Then  ' set your smtp sending port number here
 If oClient.Username <> "" Then
  Dim oApp
  Dim oWhitelistAddresses
  Dim oWhitelistAddress
  Dim oRecipient
  Dim InWhiteList
  InWhiteList = False
  Set oApp = CreateObject("hMailServer.Application") 
  Call oApp.Authenticate("Administrator","password") ' set your administrator password in this line 
  Set oWhitelistAddresses = oApp.Settings.AntiSpam.WhiteListAddresses
  For oRecipient = 0 to oMessage.Recipients.Count-1
   If Not oMessage.Recipients(oRecipient).IsLocalUser Then
    For oWhitelistAddress = 0 to oWhitelistAddresses.Count-1
     If oWhitelistAddresses(oWhitelistAddress).EmailAddress = oMessage.Recipients(oRecipient).Address Then
          oWhitelistAddresses(oWhitelistAddress).Description = Date & " Auto Add Recipient " & oMessage.Recipients(oRecipient).Address
          oWhitelistAddresses(oWhitelistAddress).Save
      InWhiteList = True
      Exit For
     End If
    Next
    If Not InWhiteList Then
     Set  oWhitelistAddress = oWhitelistAddresses.Add      
     oWhitelistAddress.LowerIPAddress = "0.0.0.0"
         oWhitelistAddress.UpperIPAddress = "255.255.255.255"
         oWhitelistAddress.emailaddress = oMessage.Recipients(oRecipient).Address
         oWhitelistAddress.description = Date & " Auto Add Recipient " & oMessage.Recipients(oRecipient).Address
         oWhitelistAddress.Save
        End If 
       End If 
  Next
 End If 
End If

'--------------------------------------------------------
Whitelist Cleanup

Following code should be saved in a new file. Call it WhitelistCleanup.vbs and place the file in your hmailserver/events folder.
You can run it manually by double clicking on it and/or you can setup a windows scheduled task to run it every day.

It deletes entries added by above whitelist script which are older than x days. Just make sure the description contains "Auto Add Recipient" in both scripts.

The effect is to remove anyone from the whitelist you have not been communicating with for the last x days so that the whitelist doesn't become too big.

Code: Select all

'Force error on undeclared variables
Option Explicit
'--------------------------------------------------------------------------
' Cleanup of Whitelist entries created with Auto Add Recipient to whitelist
'--------------------------------------------------------------------------
Dim oApp
Dim oWhitelistAddresses
Dim oWhitelistAddress
Dim Days
Days = 180  ' *** set age in days of Auto Add Recipient whitelist entries to be deleted
Dim WLDate
Dim oEventLog

Set oApp = CreateObject("hMailServer.Application") 
Call oApp.Authenticate("Administrator","password") ' set your administrator password in this line 
Set oEventlog = CreateObject("hMailServer.EventLog")
Set oWhitelistAddresses = oApp.Settings.AntiSpam.WhiteListAddresses
For oWhitelistAddress = oWhitelistAddresses.Count-1 to 0 Step -1 
 if (InStr(1, oWhitelistAddresses(oWhitelistAddress).Description, "Auto Add Recipient", 1) > 0) Then
  WLDate = Mid(oWhitelistAddresses(oWhitelistAddress).Description,1,10) 
  if DateDiff("d", WLDate, Date) >= Days then
   oEventLog.Write("Whitelist Delete: " & oWhitelistAddresses(oWhitelistAddress).EmailAddress)
     oWhitelistAddresses(oWhitelistAddress).Delete
  End If
 End If 
Next
Good luck

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

Re: Automatic Recipient Whitelisting

Post by jimimaseye » 2016-03-11 23:51

Percepts, just a thought (in case youre interested): a suggestion....

as your events script cycles through all of the existing whitelist records (before updating or adding a new one), why not do a date check on the existing records as it goes through them and delete outdated ones (as your cleanup currently does) and then that way the nightly cleanup wouldnt be required.

(Just a thought. I personally have no use for the script but just thought I would hoist the idea flag up for you).

(if you want me to remove this post suggestion to leave your thread clean, then just say and Ill delete it).
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

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Automatic Recipient Whitelisting

Post by percepts » 2016-03-12 00:08

there's a 1001 ways to skin a cat. Above is mine.
The delete script doesn't have to be run nightly. It may run weekly or monthly or quarterly or yearly depending on requirement of hmail administrator. Putting code into first script just puts heavier load on outgoing email during business hours whereas batch script can be run at quiet periods etc etc etc etc.
Also I wrote it becasue the original script used an external file with the file system object and that is what really slows it dowm. Being in the Com API the whitelist is most likely in memory so very fast access but not too sure about that.
i.e. no point trying to make it more complex than it needs to be just for the hell of it.
Last edited by percepts on 2016-03-12 00:29, edited 1 time in total.

User avatar
SorenR
Senior user
Senior user
Posts: 3748
Joined: 2006-08-21 15:38
Location: Denmark

Re: Automatic Recipient Whitelisting

Post by SorenR » 2016-03-12 00:14

I run the cleanup script here...

Code: Select all

   Sub OnBackupFailed(sReason)
      Call ExpireWhitelist
   End Sub

   Sub OnBackupCompleted()
      Call ExpireWhitelist
   End Sub
I do a weekly backup triggered by taskscheduler :mrgreen:
SørenR.

“Those who don't know history are doomed to repeat it.”
― Edmund Burke

User avatar
RvdH
Senior user
Senior user
Posts: 1111
Joined: 2008-06-27 14:42
Location: Netherlands

Re: Automatic Recipient Whitelisting

Post by RvdH » 2016-03-12 13:52

Percepts, i have been using both scripts for quit some time, but found a bug in the date format
It needs 2 digits for date and month values to properly add remove records as it expects a 10 char long date format in this line: WLDate = Mid(oWhitelistAddresses(oWhitelistAddress).Description,1,10)

I modified it like this:

Code: Select all

'--------------------------------------------------------
' Auto Whitelist recipients from auth'd senders
'--------------------------------------------------------
If oClient.Port = 25 Then  ' set your smtp sending port number here
 If oClient.Username <> "" Then
  Dim oApp
  Dim oWhitelistAddresses
  Dim oWhitelistAddress
  Dim oRecipient
  Dim InWhiteList
  InWhiteList = False
  Set oApp = CreateObject("hMailServer.Application") 
  Call oApp.Authenticate("Administrator","password") ' set your administrator password in this line 
  Set oWhitelistAddresses = oApp.Settings.AntiSpam.WhiteListAddresses
  For oRecipient = 0 to oMessage.Recipients.Count-1
   If Not oMessage.Recipients(oRecipient).IsLocalUser Then
    For oWhitelistAddress = 0 to oWhitelistAddresses.Count-1
     If oWhitelistAddresses(oWhitelistAddress).EmailAddress = oMessage.Recipients(oRecipient).Address Then
          oWhitelistAddresses(oWhitelistAddress).Description = Format2DigitDate(Date) & " Auto Add Recipient " & oMessage.Recipients(oRecipient).Address
          oWhitelistAddresses(oWhitelistAddress).Save
          oWhitelistAddresses(oWhitelistAddress).Refresh
      InWhiteList = True
      Exit For
     End If
    Next
    If Not InWhiteList Then
     Set  oWhitelistAddress = oWhitelistAddresses.Add      
     oWhitelistAddress.LowerIPAddress = "0.0.0.0"
         oWhitelistAddress.UpperIPAddress = "255.255.255.255"
         oWhitelistAddress.emailaddress = oMessage.Recipients(oRecipient).Address
         oWhitelistAddress.description = Format2DigitDate(Date) & " Auto Add Recipient " & oMessage.Recipients(oRecipient).Address
         oWhitelistAddress.Save
         oWhitelistAddress.Refresh
        End If 
       End If 
  Next
 End If 
End If

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

Function Format2DigitDate(ByVal DateTime)
	Dim dtmYear: dtmYear = Year(DateTime)
	Dim dtmMonth: dtmMonth = Month(DateTime)
	Dim dtmDay: dtmDay = Day(DateTime)
	Format2DigitDate = Right(String(2, "0") & dtmDay, 2) & "-" & Right(String(2, "0") & dtmMonth, 2) &"-" & dtmYear
End Function

Code: Select all

'Force error on undeclared variables
Option Explicit
'--------------------------------------------------------------------------
' Cleanup of Whitelist entries created with Auto Add Recipient to whitelist
'--------------------------------------------------------------------------
Dim oApp
Dim oWhitelistAddresses
Dim oWhitelistAddress
Dim Days : Days = 180 ' *** set age in days of Auto Add Recipient whitelist entries to be deleted
Dim WLDate
Dim oEventLog

Set oApp = CreateObject("hMailServer.Application") 
Call oApp.Authenticate("Administrator","password") ' set your administrator password in this line 
Set oEventlog = CreateObject("hMailServer.EventLog")
Set oWhitelistAddresses = oApp.Settings.AntiSpam.WhiteListAddresses
On Error Resume Next
For oWhitelistAddress = 0 to (oWhitelistAddresses.Count-1)
	if (InStr(1, oWhitelistAddresses(oWhitelistAddress).Description, "Auto Add Recipient", 1) > 0) Then
		WLDate = Mid(oWhitelistAddresses(oWhitelistAddress).Description,1,10) 
		if DateDiff("d", WLDate, Format2DigitDate(Date)) >= Days then
			oEventLog.Write("Whitelist Delete: " & oWhitelistAddresses(oWhitelistAddress).EmailAddress)
			oWhitelistAddresses(oWhitelistAddress).Delete
			oWhitelistAddresses.Refresh
		End If
	End If 
Next
Set oWhitelistAddresses = nothing
Set oEventlog = nothing
set oApp = nothing

Function Format2DigitDate(ByVal DateTime)
	Dim dtmYear: dtmYear = Year(DateTime)
	Dim dtmMonth: dtmMonth = Month(DateTime)
	Dim dtmDay: dtmDay = Day(DateTime)
	Format2DigitDate = Right(String(2, "0") & dtmDay, 2) & "-" & Right(String(2, "0") & dtmMonth, 2) &"-" & dtmYear
End Function
Last edited by RvdH on 2016-03-12 14:18, edited 2 times in total.
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

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Automatic Recipient Whitelisting

Post by percepts » 2016-03-12 14:10

thanks, I don't actually use it myself as I don't have a spam problem so hadn't noticed that.

User avatar
SorenR
Senior user
Senior user
Posts: 3748
Joined: 2006-08-21 15:38
Location: Denmark

Re: Automatic Recipient Whitelisting

Post by SorenR » 2016-03-12 14:43

RvdH wrote:Percepts, i have been using both scripts for quit some time, but found a bug in the date format
It needs 2 digits for date and month values to properly add remove records as it expects a 10 char long date format in this line: WLDate = Mid(oWhitelistAddresses(oWhitelistAddress).Description,1,10)
I have used the function for about a year now and never had the problem - I do not have any orphans hanging around :wink:

Must be related to your country settings or something like that...
SørenR.

“Those who don't know history are doomed to repeat it.”
― Edmund Burke

User avatar
RvdH
Senior user
Senior user
Posts: 1111
Joined: 2008-06-27 14:42
Location: Netherlands

Re: Automatic Recipient Whitelisting

Post by RvdH » 2016-03-12 18:45

Are you sure?

If you take for example 2-3-2016 or 2/3/2016

Response.Write(Mid("2-3-2016" & " Auto Add Recipient",1,10))
Response.Write(Mid("2/3/2016" & " Auto Add Recipient",1,10))

returns either: '2-3-2016 A' or '2/3/2016 A'

Well as these are no valid dates the date comparison fails and nothing gets cleaned up
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

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

Re: Automatic Recipient Whitelisting

Post by jimimaseye » 2016-03-12 19:46

FYI, for me:

VBS:
wscript.echo date

output: 12/03/2106 (not 12/3/2016).

So format is dd/mm/yyyy by default.

You sure its not down to your date/time format in windows REGION AND LANGUAGE settings - maybe yours is d/m/yy? This format above matches my windows settings and if I change it to dd/mm/yy it does then display as "12/3/16".

With that in mind, it would make sense to make the script 'universal' by applying some sort of cleanup to allow formats that are not dd/mm/yyyy (10 chars long).
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

User avatar
RvdH
Senior user
Senior user
Posts: 1111
Joined: 2008-06-27 14:42
Location: Netherlands

Re: Automatic Recipient Whitelisting

Post by RvdH » 2016-03-12 19:50

wscript.echo date return 12-3-2016 for me

What i am trying to tell is with above changes it works in all cases! Regional settings independent
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

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

Re: Automatic Recipient Whitelisting

Post by jimimaseye » 2016-03-12 23:05

BTW, I reckon you could actually just use:

Code: Select all

      if DateDiff("d", WLDate, now()) >= Days then
(instead of if DateDiff("d", WLDate, Format2DigitDate(Date)) >= Days then )

in the cleanup routine. ("now()" is the current date and needs no reformatting as its independent of actual region settings.).
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

User avatar
RvdH
Senior user
Senior user
Posts: 1111
Joined: 2008-06-27 14:42
Location: Netherlands

Re: Automatic Recipient Whitelisting

Post by RvdH » 2016-03-12 23:09

now() returns: 12-3-2016 22:07:10 so that won't make no difference
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

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

Re: Automatic Recipient Whitelisting

Post by jimimaseye » 2016-03-12 23:14

For example:

(From 1st of March)
wscript.echo DateDiff("d","01-3-16", now())

wscript.echo DateDiff("d","1-03-16", now())

wscript.echo DateDiff("d","1-3-2016", now())

wscript.echo DateDiff("d","01-03-16", now())
will all report '11' (today is 12th March)

The format of the input date is irrelevant to the system settings just as long as its a valid date.
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

User avatar
RvdH
Senior user
Senior user
Posts: 1111
Joined: 2008-06-27 14:42
Location: Netherlands

Re: Automatic Recipient Whitelisting

Post by RvdH » 2016-03-12 23:21

What the hell? That is exactly what i am saying isn't it?

Only the variable WLDate that is taken from the string when doing the cleanup is not a valid date when it is stored like 1-3-2016 in the whitelist as with the MID("1-3-2016 Auto Add Recipient user@example.com",1,10) it returns '1-3-2016 A'
Last edited by RvdH on 2016-03-12 23:28, edited 2 times in total.
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

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

Re: Automatic Recipient Whitelisting

Post by jimimaseye » 2016-03-12 23:25

What I meant was considering that other people might have their regional settings set as d.m.yy, for example, and using the datediff of the 10character dd/mm/yyyy formatted WLDATE against now() will still work.

I acknowledge and agree with you that the writing of the date in to the record (making it 10 characters using your function) is required, but your function isnt needed to convert current date when then making the comparison to it in the cleanup.

(I mentioned using now() instead of 'date' because I have used it in my own scripts - I hadnt tested 'date')

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

User avatar
SorenR
Senior user
Senior user
Posts: 3748
Joined: 2006-08-21 15:38
Location: Denmark

Re: Automatic Recipient Whitelisting

Post by SorenR » 2016-03-13 00:33

Image

"MyToolBox" is a class I made with various tools... 8)

Code: Select all

   Sub AutoWhitelist(oMessage)
      Dim oWhiteListAddresses, oWhiteListAddress
      Dim i, j, InWhiteList, MyTools
      InWhiteList = False
      Set MyTools = New MyToolBox
      MyTools.InitCOM("oApp")
      Set oWhiteListAddresses = oApp.Settings.AntiSpam.WhiteListAddresses
      For i = oMessage.Recipients.Count-1 To 0 Step -1
         If (Not oMessage.Recipients(i).IsLocalUser) Then
            For j = oWhiteListAddresses.Count-1 To 0 Step -1
               If (oWhiteListAddresses(j).EmailAddress = oMessage.Recipients(i).Address) Then
                  oWhiteListAddresses(j).Description = Date & " Auto Add Recipient " & oMessage.Recipients(i).Address
                  oWhiteListAddresses(j).Save
                  InWhiteList = True
                  Exit For
               End If
            Next
            If (Not InWhiteList) Then
               Set oWhiteListAddress = oWhiteListAddresses.Add
               oWhiteListAddress.LowerIPAddress = "0.0.0.0"
               oWhiteListAddress.UpperIPAddress = "255.255.255.255"
               oWhiteListAddress.EmailAddress = oMessage.Recipients(i).Address
               oWhiteListAddress.Description = Date & " Auto Add Recipient " & oMessage.Recipients(i).Address
               oWhiteListAddress.Save
            End If
         End If
      Next
   End Sub

   Sub ExpireWhitelist
      Dim oWhiteListAddresses
      Dim j, Days, MyTools
      Days = 180
      Set MyTools = New MyToolBox
      MyTools.InitCOM("oApp")
      Set oWhiteListAddresses = oApp.Settings.AntiSpam.WhiteListAddresses
      For j = oWhiteListAddresses.Count-1 To 0 Step -1
         If (InStr(oWhiteListAddresses(j).Description, "Auto Add Recipient") > 0) Then
            If (DateDiff("d", Mid(oWhiteListAddresses(j).Description,1,10), Date) > Days) Then
               oWhiteListAddresses(j).Delete
            End If
         End If
      Next
   End Sub
SørenR.

“Those who don't know history are doomed to repeat it.”
― Edmund Burke

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Automatic Recipient Whitelisting

Post by percepts » 2016-03-13 00:53

Using Now does NOT fix the problem.

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Automatic Recipient Whitelisting

Post by percepts » 2016-03-13 00:54

How to auto whitelist recipients you send email to.

Veriosn 2 : Fixed Date comparison error spotted by RvdH (caused by assumed date text length which was incorrect)

These two scripts have been placed here to make them easier to get at and replace the two scripts at end of following topic.

viewtopic.php?p=155678#p155678

These two scripts are for the purpose of whitelisting any recipients that you send email to. The main benefit is that it allows any external incoming email address that you have sent email, to bypass greylisting when they send their first mail to you and are not dependant on their mail servers smtp retry period which can delay you from receiving their email quickly. i.e. if you need a mail from someone external quickly and you are running greylisting, then just send them an email they can respond to and it should get through to you on their first attempt without being bounced with a 451 temporary failure message to them..

Note: script will only whitelist them to send to your user sending address and not to any other user at your own domain.

Auto Whitelist
The potential downsides to this script are, firstly it may quickly build a very large whitelist if you are sending to hundreds or more recipients. And secondly because it has to trawl through the full whitelist to check if the address is already in list(no method available to read by email address), it will become slow if the list grows to hundreds or more entries. But then again, it isn't using any external files with open and closes which slows down hMail. There is a cleanup script below so whitelist size can be managed to not grow too big with dormant entries.
Also no Spam checking on anything in whitelist, i.e. when you send to anyone then anything they send to you is not spam checked.

I did quick testing and it seems to work fine with gmail address I tested with greylisting switched on. i.e. it created whitelist and then it let gmail address straight through.

Place code in your onAcceptMessage Sub (in eventhandlers vbs) and set your admin password in code. Save and reload scripts. It's as simple as that.

Code: Select all

'--------------------------------------------------------
' Auto Whitelist recipients from auth'd senders
'--------------------------------------------------------
If oClient.Port = 25 Then  ' set your smtp sending port number here
 If oClient.Username <> "" Then
  Dim oApp
  Dim oWhitelistAddresses
  Dim oWhitelistAddress
  Dim oRecipient
  Dim InWhiteList
  InWhiteList = False
  Set oApp = CreateObject("hMailServer.Application") 
  Call oApp.Authenticate("Administrator","password") ' set your administrator password in this line 
  Set oWhitelistAddresses = oApp.Settings.AntiSpam.WhiteListAddresses
  For oRecipient = 0 to oMessage.Recipients.Count-1
   If Not oMessage.Recipients(oRecipient).IsLocalUser Then
    For oWhitelistAddress = 0 to oWhitelistAddresses.Count-1
     If oWhitelistAddresses(oWhitelistAddress).EmailAddress = oMessage.Recipients(oRecipient).Address Then
          oWhitelistAddresses(oWhitelistAddress).Description = Date & " Auto Add Recipient " & oMessage.Recipients(oRecipient).Address
          oWhitelistAddresses(oWhitelistAddress).Save
      InWhiteList = True
      Exit For
     End If
    Next
    If Not InWhiteList Then
     Set  oWhitelistAddress = oWhitelistAddresses.Add      
     oWhitelistAddress.LowerIPAddress = "0.0.0.0"
         oWhitelistAddress.UpperIPAddress = "255.255.255.255"
         oWhitelistAddress.emailaddress = oMessage.Recipients(oRecipient).Address
         oWhitelistAddress.description = Date & " Auto Add Recipient " & oMessage.Recipients(oRecipient).Address
         oWhitelistAddress.Save
        End If 
       End If 
  Next
 End If 
End If

'--------------------------------------------------------
Whitelist Cleanup

Following code should be saved in a new file. Call it WhitelistCleanup.vbs and place the file in your hmailserver/events folder.
You can run it manually by double clicking on it and/or you can setup a windows scheduled task to run it every day.

It deletes entries added by above whitelist script which are older than x days. Just make sure the description contains "Auto Add Recipient" in both scripts.

The effect is to remove anyone from the whitelist you have not been communicating with for the last x days so that the whitelist doesn't become too big.

Code: Select all

'Force error on undeclared variables
Option Explicit
'--------------------------------------------------------------------------
' Cleanup of Whitelist entries created with Auto Add Recipient to whitelist
'--------------------------------------------------------------------------
Dim oApp
Dim oWhitelistAddresses
Dim oWhitelistAddress
Dim Days
Days = 180  ' *** set age in days of Auto Add Recipient whitelist entries to be deleted
Dim WLDate
Dim oEventLog

Set oApp = CreateObject("hMailServer.Application") 
Call oApp.Authenticate("Administrator","~~visual") ' set your administrator password in this line 
Set oEventlog = CreateObject("hMailServer.EventLog")
Set oWhitelistAddresses = oApp.Settings.AntiSpam.WhiteListAddresses
For oWhitelistAddress = oWhitelistAddresses.Count-1 to 0 Step -1
 if (InStr(1, oWhitelistAddresses(oWhitelistAddress).Description, "Auto Add Recipient", 1) > 0) Then
  WLDate = Mid(oWhitelistAddresses(oWhitelistAddress).Description,1,(inStr(1, oWhitelistAddresses(oWhitelistAddress).Description, " " , 1)-1)) 
  if DateDiff("d", WLDate, Date) > Days then
   oEventLog.Write("Whitelist Delete: " & oWhitelistAddresses(oWhitelistAddress).EmailAddress)
	  oWhitelistAddresses(oWhitelistAddress).Delete
  End If
 End If 
Next
oWhitelistAddresses.Refresh
'--------------------------------------------------------
Good luck
Last edited by percepts on 2016-03-13 01:16, edited 2 times in total.

User avatar
SorenR
Senior user
Senior user
Posts: 3748
Joined: 2006-08-21 15:38
Location: Denmark

Re: Automatic Recipient Whitelisting

Post by SorenR » 2016-03-13 00:59

FYI...

Code: Select all

    Function pd(n, totalDigits)
        if totalDigits > len(n) then
            pd = String(totalDigits-len(n),"0") & n
        else
            pd = n
        end if
    End Function

    wscript.echo "YYYYMMDD"
    wscript.echo YEAR(Date()) & Pd(Month(date()),2) & Pd(DAY(date()),2)


    wscript.echo "YYYY-MM-DD This is common format used for storing DATE data type in MySQL and SQL Server."
    wscript.echo YEAR(Date()) & "-" & Pd(Month(date()),2) & "-" & Pd(DAY(date()),2)


    wscript.echo "DDMMYYYY"
    wscript.echo Pd(DAY(date()),2) & Pd(Month(date()),2) & YEAR(Date())


    wscript.echo "MMDDYYYY"
    wscript.echo Pd(Month(date()),2) & Pd(DAY(date()),2) & YEAR(Date())


    wscript.echo "DD-MM-YY"
    wscript.echo pd(DAY(date()),2) & "-" & pd(MONTH(date()),2) & "-" & pd(RIGHT(YEAR(date()),2),2)


    wscript.echo "YY-MM-DD"
    wscript.echo pd(RIGHT(YEAR(date()),2),2) & "-" & pd(MONTH(date()),2) & "-" & pd(DAY(date()),2)
http://www.linglom.com/programming/how- ... p-classic/
SørenR.

“Those who don't know history are doomed to repeat it.”
― Edmund Burke

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Automatic Recipient Whitelisting

Post by percepts » 2016-03-13 02:59

not really relevant Soren. DateDiff handles dates without leading zeros on days or months or years perfectly well. The root problem was the assumed text format date being 10 chars which it was not always.

Adding leading leading zeroes is treating the symptom and not the casue. My fix treats the cause. Problem solved for all regional settings I think.

DateDiff converts input to internal date format based on regional settings so unless someone changes their regional settings without clearing out whitelist entries, they should be OK. Not much you can do to stop that since Windows regional settings would need to activate a whitelist wipe function when date format is changed. Rarely if ever likely to happen anyway and wouldn't cause a major problem even if it did.

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Automatic Recipient Whitelisting

Post by percepts » 2016-03-13 04:25

amazing how much bad spaghetti code is created by programmers fixing symptoms instead of root cause which is usually much simpler and concise.

User avatar
RvdH
Senior user
Senior user
Posts: 1111
Joined: 2008-06-27 14:42
Location: Netherlands

Re: Automatic Recipient Whitelisting

Post by RvdH » 2016-03-13 08:45

percepts, you are absolutely right...your fix handles the cause as it was indeed the assumed 10 chars length that was faulty and it is much cleaner as the fix i created myself

The issue was caused by Dutch (The Netherlands) country & regional settings in Windows, eg:

Image
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

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Automatic Recipient Whitelisting

Post by percepts » 2016-03-13 10:59

it could have happened in any countries settings. Just depended on date settings and also whether both the month and the day were single digits.
If only one of them was single digits then 10th character would be a space and that doesn't cause a datediff failure. Only when 10th character was not a digit or space would it fail.
Anyway it should be OK for all countries and date formats now I think.

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

Re: Automatic Recipient Whitelisting

Post by jimimaseye » 2016-03-13 11:55

Percepts would you like your latest fixed version to be put in your opening post so that the first script seen is now your latest working version? (Or I could put a comment in it to point people to your VERSION 2 further down)
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

User avatar
SorenR
Senior user
Senior user
Posts: 3748
Joined: 2006-08-21 15:38
Location: Denmark

Re: Automatic Recipient Whitelisting

Post by SorenR » 2016-03-13 12:30

percepts wrote:not really relevant Soren.
I know, that's why it said FYI and not FIX ;-)
SørenR.

“Those who don't know history are doomed to repeat it.”
― Edmund Burke

Post Reply