Automatic whitelisting

This section contains scripts that hMailServer has contributed with. hMailServer 4 is needed to use these.
Post Reply
andyp
Normal user
Normal user
Posts: 198
Joined: 2008-01-18 21:00

Automatic whitelisting

Post by andyp » 2008-03-27 11:11

This is the result of feature request http://www.hmailserver.com/forum/viewto ... =2&t=11534

This script remembers the recipients from any authenticated smtp user and add them to the global whitelist. Also all members of the lists are added.

Installation instruction:

1. Activate Scripting in hmailserver, should be in hm admin tool: settings->advanced->settings

2. Click on show scripts and open eventhandler.vbs

3a. in case you aren't using any vbs scripts at the moment
Paste the whole script into the the eventhandler.vbs file

3b. in case you are using vbs scripts
paste the global variables (every line at the top starting with public) at the top of your script file
activate and/or integrated the provided content of sub OnAcceptMessage in your OnAcceptMessage
(just paste the provided content in your sub should do the trick)
paste the subs and functions below the sub OnAcceptMessage at the end of your script
(starts with the line sub register_emailadress(oClient, oMessage))

4 do the settings
iplocalhost ist the ip of the localhost from where you can send mails without authentification
user and pw is the login data to hmailserver
dbg is boolean and instructs the script to log the actions or not
remember_wl_address is the amount of days the outgoing addresses are stored
emailaddressesfile is the file in which the addresses are stored, can be anywhere on your server, i put it in the events dir of hm
logspath is the path where the logs of hm are saved, make sure it ends with a backslash (\)

5a switch on smtp logs of hm

5b you are not happy about my solution and the function get_smtp_recipient, which reads the recipients out of the log file
generally changing sub register_emailadress should do it
change the code and take the recipients of the method message.recipients.
variable toarr must be an array of recipients
get_smtp_recipient returns a string of recipients separated by #, see line toarr = Split(get_smtp_recipient(oClient.IPAddress),"#")


6 save the file and close the editor

7 check syntax of the script in hm

8a syntax is correct -> reload the script in hm

8b syntax check fails -> check the error message an correct

9 check the event log and the emailaddressfile and see if it works according to your testing
(this script writes a separate logfile in the logspath)

As I extracted the code from a lot more scripts and didn't test it in a stand alone environment, we need a volunteer here ...

... westdam tested the stand alone version, see below.

Couldn't upload the code via file so here it is ...

Code: Select all


Public obApp
Public Const iplocalhost = "a.b.c.d"
Public Const user = "Administrator"
Public Const pw = "yourpw"
public const dbg = true

Public Const remember_wl_address = 180
Public Const emailaddressesfile = "C:\Program Files (x86)\hMailServer\Events\emailaddresses.txt"
Public Const logspath = "C:\Program Files (x86)\hMailServer\Logs\"

'Sub OnClientConnect(oClient)
'End Sub

'Sub OnDeliveryStart(oMessage)
'End Sub

'Sub OnDeliverMessage(oMessage)
'End Sub

'Sub OnBackupFailed(sReason)
'End Sub

'Sub OnBackupCompleted()
'End Sub

Sub OnAcceptMessage(oClient, oMessage)
	Set obApp = CreateObject("hMailServer.Application")
	Call obApp.Authenticate(user, pw)
	
	If oCLient.username <> "" Or oClient.IPAddress = iplocalhost Then
		write_log ("-->User has authenticated. User " & oCLient.username & ", Client " & oClient.IPAddress)
		register_emailadress oClient, oMessage
	End if
	
End Sub

sub register_emailadress(oClient, oMessage)
	'uses functions: get_smtp_recipient, update_whitelist
	'uses globals: emailaddressesfile, remember_wl_address
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	Dim fs , f
	Set fs = CreateObject("scripting.filesystemobject")
	Dim ln
	Dim arr
	Dim fnd(2000)
	Dim fd
	Dim content
	Dim upd
	upd = False
	
	Dim mailto
	Dim toarr
	toarr = Split(lcase(get_smtp_recipient(oClient.IPAddress)),"#")
	
	content = ""
	For i = 0 To UBound(toarr)
		fnd(i) = False
	Next
	
	If fs.FileExists(emailaddressesfile) Then
		Set f = fs.OpenTextFile(emailaddressesfile, ForReading)
		Do While Not f.AtEndOfStream
			ln = f.ReadLine
			If ln <> "" Then
				arr = Split(ln,Chr(9))
				
				fd = false
				For j = 0 To UBound(toarr)
					mailto = toarr(j)
					If arr(0) = mailto Then
						fd = True
						fnd(j) = True
					End If
				Next
				If fd = True then
					write_log ("  adding to line " & ln)
					content = content & arr(0) & Chr(9) & arr(1) + 1 & Chr(9) & Date() & Chr(9) & CLng(Date()) & nl
				ElseIf CLng(arr(3)) < CLng(Date()) - remember_wl_address Then
					write_log ("  deleting line " & ln)
					upd = true
				Else
					content = content & ln & nl
				End If
			End if
		Loop
		f.Close
	End If
	
	For i = 0 To UBound(toarr)
		If fnd(i) = False Then
			content = content & toarr(i) & Chr(9) & 1 & Chr(9) & Date() & Chr(9) & CLng(Date()) & nl
			write_log ("  adding new line")
			upd = true
		End If
	next
	
	Set f = fs.OpenTextFile(emailaddressesfile, ForWriting, true)
	f.Write(content)
	write_log ("  writing emailaddressesfile")
	f.Close
	
	If upd = True Then
		update_whitelist
	End If
	
End Sub

Sub update_whitelist()
	'uses functions:
	'uses globals: obapp, emailaddressesfile
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	Set fs = CreateObject("scripting.filesystemobject")
	Dim i
	Dim j
	Dim k
	Dim ln
	Dim arr
	Dim dom
	Dim lstrcps
	Dim rcp
	Set whtlst = obapp.Settings.AntiSpam.WhiteListAddresses
	Dim lstadrs
	lstadrs = ""
	Dim lstadrsarr
	
	i = whtlst.Count - 1
	Do While i >= 0
		Set wlo = whtlst.Item(i)
		If Mid(wlo.Description,1,5) = "zvbs_" Or Mid(wlo.Description,1,5) = "zlst_" Then
			whtlst.DeleteByDBID(whtlst.Item(i).id)
		End If
		i = i - 1
	loop
	
	If fs.FileExists(emailaddressesfile) Then
		Set f = fs.OpenTextFile(emailaddressesfile, ForReading)
		
		Do While Not f.AtEndOfStream
			ln = f.ReadLine
			arr = Split(ln,Chr(9))
			
			If UBound(arr) = 3 Then
				Set nwl = whtlst.Add
				nwl.LowerIPAddress = "0.0.0.0"
				nwl.UpperIPAddress = "255.255.255.255"
				nwl.emailaddress = arr(0)
				nwl.description = "zvbs_" & arr(0)
				nwl.Save
			End if
		Loop
		write_log("  Updating whitelist successful.")
	Else
		write_log("  Updating whitelist error: no emailadress file found.")
	End If
	
	i = 0
	Do While i <= obapp.Domains.Count - 1
		Set dom = obapp.Domains.Item(i)
		j = 0
		'write_log("    " & dom.Name)
		Do While j <= dom.DistributionLists.Count - 1
			Set lstrcps = dom.DistributionLists.Item(j).recipients
			k = 0
			'write_log("      " & dom.DistributionLists.Item(j).address)
			Do While k <= lstrcps.count - 1
				Set rcp = lstrcps.item(k)
				'write_log("        " & rcp.recipientaddress)
				If Not InStr(1, lstadrs, rcp.recipientaddress) > 0 Then
					lstadrs = lstadrs & rcp.recipientaddress & "#"
				End If
				k = k + 1
			Loop
			j = j + 1
		Loop
		i = i + 1
	Loop
	
	If Len(lstadrs) > 1 Then
		lstadrs = Mid(lstadrs,1,Len(lstadrs) -1)
	End if
	lstadrsarr = Split(lstadrs,"#")
	i = 0
	Do While i <= UBound(lstadrsarr)
		Set nwl = whtlst.Add
		nwl.LowerIPAddress = "0.0.0.0"
		nwl.UpperIPAddress = "255.255.255.255"
		nwl.emailaddress = lstadrsarr(i)
		nwl.description = "zlst_" & lstadrsarr(i)
		nwl.Save
		'write_log("  adding " & lstadrsarr(i))
		i = i + 1
	Loop
	If UBound(lstadrsarr) > 0 then
		write_log("  Updating whitelist successful. Adding list members. Nr " & UBound(lstadrsarr) + 1)
	End if
End sub

Function get_smtp_recipient(ipaddr)
	'uses functions: get_date
	'uses globals: logspath
    get_smtp_recipient = ""
    Dim fs
    Dim f
    Set fs = CreateObject("scripting.filesystemobject")
    
    Dim fn
    Dim ln
    Dim arr
    Dim tmp
    Dim erg
    erg = ""
    
    fn = logspath & "hmailserver_" & get_date & ".log"
    
    If fs.FileExists(fn) Then
        Set f = fs.opentextfile(fn)
        Do While Not f.AtEndOfStream
            ln = f.ReadLine
            arr = Split(ln, Chr(9))
            If UBound(arr) = 5 Then
                tmp = ""
                If arr(0) = """SMTPD""" And arr(4) = """" & ipaddr & """" And InStr(1, "  " & arr(5), "RECEIVED: EHLO") > 0 Then
                    erg = ""
                End If
                If arr(0) = """SMTPD""" And arr(4) = """" & ipaddr & """" And InStr(1, "  " & arr(5), "RECEIVED: HELO") > 0 Then
                    erg = ""
                End If
                If arr(0) = """SMTPD""" And arr(4) = """" & ipaddr & """" And InStr(1, "  " & arr(5), "SENT: 220 mailserver1.integrated-networks.de ESMTP") > 0 Then
                    erg = ""
                End If
                If arr(0) = """SMTPD""" And arr(4) = """" & ipaddr & """" And InStr(1, arr(5), "RCPT") > 0 And InStr(1, arr(5), "<") > 0 And InStr(1, arr(5), ">") > 0 Then
                    tmp = Mid(arr(5), InStr(1, arr(5), "<") + 1)
                    tmp = Mid(tmp, 1, InStr(1, tmp, ">") - 1)
                End If
                If erg = "" And tmp <> "" Then
                	erg = tmp & "#"
                elseIf tmp <> "" Then
                    If InStr(1,"   " & erg,tmp) <= 1 Then
                    	erg = erg & tmp & "#"
                    End if
                End If
            End If
        Loop
        f.Close
    End If
    If erg <> "" Then
        get_smtp_recipient = Mid(erg, 1, Len(erg) - 1)
    End If
End Function

Sub write_log(txt)
	'uses functions: get_date, nl
	'uses globals: logspath
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	Dim fs
	Dim f
	
	Set fs = CreateObject("scripting.filesystemobject")
	
	Dim fn
	Dim tmp 
    fn = logspath & "hmailserver_event_" & get_date & ".log"
	If dbg = True Then
		Set f = fs.opentextfile(fn, ForAppending, true)
		tmp = """" & FormatDateTime(Date + time,0) & """" & Chr(9) & """" & txt & """" & nl
		f.Write(tmp)
		f.close
	End If
End Sub

Function get_date
	Dim tmp
	Dim erg
	tmp = Year(Date)
	erg = CStr(tmp)
	
	If Month(Date) < 10 Then
		tmp = "0" & Month(Date)
	Else
		tmp = Month(Date)
	End If
	erg = erg & "-" & tmp
	
	If day(Date) < 10 Then
		tmp = "0" & day(Date)
	Else
		tmp = day(Date)
	End If
	erg = erg & "-" & tmp
	
	get_date = erg
End Function

Function nl
	nl = Chr(13) & Chr(10)
End function
Last edited by andyp on 2008-07-31 14:02, edited 7 times in total.

westdam
Senior user
Senior user
Posts: 731
Joined: 2006-08-01 21:24
Location: Padova, Italy
Contact:

Re: Automatic whitelisting

Post by westdam » 2008-03-27 13:25

great andy..

just for newbies ;) where this code must be pasted? :D

(so you have done a perfect nebiew-howto)

andyp
Normal user
Normal user
Posts: 198
Joined: 2008-01-18 21:00

Re: Automatic whitelisting

Post by andyp » 2008-03-27 13:57

OK, let's start ...

Open hm administration and activate scripting. Click then on show scripts or something like this - I have got the German version.

You should see the event functions with ' at the beginning of each line, this means the lines are not active. Paste the Pulbic * lines on top of the event functions , do the settings acording to your installation. Overwrite or change (in case you have got already content in OnAcceptMessage) the function OnAcceptMessage with the content of OnAcceptMessage I provided, don't forget to delete the ' at the beginning of the line. Paste all other functions at the end. Save file and exit.

Remember you need to log SMTP traffic!!!

Press Check Syntax and send me the error message in case there have been some errors in my code. You find the errors in a file in the logs directory of hmailserver named like ERROR_hmailserver_2008-03-27.log.

In case of a correct syntax press reload scripts in hmail administration. The script is writing in a log file called hmailserver_event_2008-03-27.log. Check if it works...

winchester
New user
New user
Posts: 2
Joined: 2008-03-27 17:52

Re: Automatic whitelisting

Post by winchester » 2008-03-27 18:02

I have been wanting to have something like this.
Last edited by winchester on 2008-03-28 14:43, edited 1 time in total.

Kaan1983
Senior user
Senior user
Posts: 595
Joined: 2007-01-30 16:26
Location: TÜRKIYE

Re: Automatic whitelisting

Post by Kaan1983 » 2008-03-27 21:46

Great job andyp, thanks for sharing.

andyp
Normal user
Normal user
Posts: 198
Joined: 2008-01-18 21:00

Re: Automatic whitelisting

Post by andyp » 2008-03-28 11:52

OK, I see it is not easy without hm com api or programming experience

Change post one, please look here

---

As I extracted this functions out of my 5000 lines of code, has anyone tried the provided standalone version and knows if the functions above are complete and working? I am sorry, I have no test server and always make changes in the productive environment.
Last edited by andyp on 2008-03-29 11:09, edited 1 time in total.

winchester
New user
New user
Posts: 2
Joined: 2008-03-27 17:52

Re: Automatic whitelisting

Post by winchester » 2008-03-28 14:39

Thanks for the update. Those steps would be much easier to follow for some that dont have all the knowledge.

I am testing it.

westdam
Senior user
Senior user
Posts: 731
Joined: 2006-08-01 21:24
Location: Padova, Italy
Contact:

Re: Automatic whitelisting

Post by westdam » 2008-03-28 18:54

tested.
works fine andy

andyp
Normal user
Normal user
Posts: 198
Joined: 2008-01-18 21:00

Re: Automatic whitelisting

Post by andyp » 2008-03-29 11:10

forgot the global variable dbg

it instruct the script to log it actions, see code above

westdam
Senior user
Senior user
Posts: 731
Joined: 2006-08-01 21:24
Location: Padova, Italy
Contact:

Re: Automatic whitelisting

Post by westdam » 2008-04-02 18:06

hey andy works nice

just a trouble but it's not related to your script..
i've got some customer which had a forum with automatic registration and the forum use hmailserver to send mail.SO the whitelist is now plenty of spammer's email registered via forum..


anyway no trouble so far in other installation . great works


ah suggestion : it's better to use 60 days instead 180. if there's high load the Txt file becomes bigger soon and could take time to open it. sql doesnt have trouble of course.

andyp
Normal user
Normal user
Posts: 198
Joined: 2008-01-18 21:00

Re: Automatic whitelisting

Post by andyp » 2008-04-07 14:56

Well, I have got 30 users and so a very small installation. My file is about 20 k after 4 months with 180 days.

But therefore the setting days is ...

SQL would be nice, but implementing and changing the hmailserver database schema is not impossible, but a lot more work to do. And for you not easy to install and migrate. And you need some database activex component.

I happy to see it works with larger installations as well.

westdam
Senior user
Senior user
Posts: 731
Joined: 2006-08-01 21:24
Location: Padova, Italy
Contact:

Re: Automatic whitelisting

Post by westdam » 2008-04-07 15:03

well mine installation is small too. I've got 10 domains and 80 users. Not so much but hmailserver works perfectly.
Anyway your script is working well too.

Leoh
New user
New user
Posts: 1
Joined: 2008-07-02 19:04

Re: Automatic whitelisting

Post by Leoh » 2008-07-13 20:22

Thks for this Great Job andyp. :D

BrandonH75
Normal user
Normal user
Posts: 41
Joined: 2007-06-18 20:46
Location: MN

Re: Automatic whitelisting

Post by BrandonH75 » 2008-07-29 18:52

I'm trying this out with about 150 users on one domain.

I don't know anything about vbs, but I finally got up enough courage to try using someone's script. So far so good! :D

andyp
Normal user
Normal user
Posts: 198
Joined: 2008-01-18 21:00

Re: Automatic whitelisting

Post by andyp » 2008-07-30 15:19

Well, then tell us how it works.

I found a very small bug and replaced it in the code above. Nothing serious.

replace toarr = Split(get_smtp_recipient(oClient.IPAddress),"#")
with toarr = Split(lcase(get_smtp_recipient(oClient.IPAddress)),"#")

The old script is case sensitive. Email addresses aren't, so ...

If you have used to old one, please simply sort the txt file alphabetical and deleted the doubled addresses. Also changed the addresses to lower case. Access or Word can do the trick.

mns17
Normal user
Normal user
Posts: 124
Joined: 2008-06-18 11:13

Re: Automatic whitelisting

Post by mns17 » 2008-10-10 11:13

Update:

Code: Select all

  
   Public obApp
Public Const iplocalhost = "0.0.0.0"
Public Const yuordomain = "yuordomain "
Public Const user = "Administrator"
Public Const pw = "pw"
public const dbg = true

Public Const remember_wl_address = 500
Public Const emailaddressesfile = "C:\Program Files\hMailServer\Events\emailaddresses.txt"
Public Const logspath = "C:\Program Files\hMailServer\Logs\"

'Sub OnClientConnect(oClient)
'End Sub

'Sub OnDeliveryStart(oMessage)
'End Sub

'Sub OnDeliverMessage(oMessage)
'End Sub

'Sub OnBackupFailed(sReason)
'End Sub

'Sub OnBackupCompleted()
'End Sub

Sub OnAcceptMessage(oClient, oMessage)
   Set obApp = CreateObject("hMailServer.Application")
   Call obApp.Authenticate(user, pw)
   
   If oCLient.username <> "" Or oClient.IPAddress = iplocalhost Then
      write_log ("-->User has authenticated. User " & oCLient.username & ", Client " & oClient.IPAddress)
      register_emailadress oClient, oMessage
   End if
   
End Sub

sub register_emailadress(oClient, oMessage)
   'uses functions: get_smtp_recipient, update_whitelist
   'uses globals: emailaddressesfile, remember_wl_address
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs , f
   Set fs = CreateObject("scripting.filesystemobject")
   Dim ln
   Dim arr
   Dim fnd(2000)
   Dim fd
   Dim content
   Dim upd
   Dim erg
   Dim tmp
   upd = False
   
   Dim mailto
   Dim toarr
   Dim Domain_to
   
   Set obRecipients = oMessage.Recipients
   erg = ""
   For i = 0 to obRecipients.Count - 1
   Set obRecipient = obRecipients.Item(i)
   tmp = obRecipient.Address
   Domain_to = Split(lcase(tmp),"@")  
     If Domain_to(1) <> yuordomain Then
     erg = erg & tmp & "#"      
     End if
   tmp = ""
   Next  
If erg <> "" Then
   erg = Mid(erg, 1, Len(erg) - 1)
   toarr = Split(lcase(erg),"#")

   content = ""
   For i = 0 To UBound(toarr)
      fnd(i) = False
   Next
   
   If fs.FileExists(emailaddressesfile) Then
      Set f = fs.OpenTextFile(emailaddressesfile, ForReading)
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         If ln <> "" Then
            arr = Split(ln,Chr(9))
            
            fd = false
            For j = 0 To UBound(toarr)
               mailto = toarr(j)
               If arr(0) = mailto Then
                  fd = True
                  fnd(j) = True
               End If
            Next
            If fd = True then
               write_log ("  adding to line " & ln)
               content = content & arr(0) & Chr(9) & arr(1) + 1 & Chr(9) & Date() & Chr(9) & CLng(Date()) & nl
            ElseIf CLng(arr(3)) < CLng(Date()) - remember_wl_address Then
               write_log ("  deleting line " & ln)
               upd = true
            Else
               content = content & ln & nl
            End If
         End if
      Loop
      f.Close
   End If
   
   For i = 0 To UBound(toarr)
      If fnd(i) = False Then
         content = content & toarr(i) & Chr(9) & 1 & Chr(9) & Date() & Chr(9) & CLng(Date()) & nl
         write_log ("  adding new line")
         upd = true
      End If
   next
   
   Set f = fs.OpenTextFile(emailaddressesfile, ForWriting, true)
   f.Write(content)
   write_log ("  writing emailaddressesfile")
   f.Close
   
   If upd = True Then
      update_whitelist
   End If
End If   
End Sub

Sub update_whitelist()
   'uses functions:
   'uses globals: obapp, emailaddressesfile
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Set fs = CreateObject("scripting.filesystemobject")
   Dim i
   Dim j
   Dim k
   Dim ln
   Dim arr
   Dim dom
   Dim lstrcps
   Dim rcp
   Set whtlst = obapp.Settings.AntiSpam.WhiteListAddresses
   Dim lstadrs
   lstadrs = ""
   Dim lstadrsarr
   
   i = whtlst.Count - 1
   Do While i >= 0
      Set wlo = whtlst.Item(i)
      If Mid(wlo.Description,1,5) = "zvbs_" Or Mid(wlo.Description,1,5) = "zlst_" Then
         whtlst.DeleteByDBID(whtlst.Item(i).id)
      End If
      i = i - 1
   loop
   
   If fs.FileExists(emailaddressesfile) Then
      Set f = fs.OpenTextFile(emailaddressesfile, ForReading)
      
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         arr = Split(ln,Chr(9))
         
         If UBound(arr) = 3 Then
            Set nwl = whtlst.Add
            nwl.LowerIPAddress = "0.0.0.0"
            nwl.UpperIPAddress = "255.255.255.255"
            nwl.emailaddress = arr(0)
            nwl.description = "zvbs_" & arr(0)
            nwl.Save
         End if
      Loop
      write_log("  Updating whitelist successful.")
   Else
      write_log("  Updating whitelist error: no emailadress file found.")
   End If
   
   i = 0
   Do While i <= obapp.Domains.Count - 1
      Set dom = obapp.Domains.Item(i)
      j = 0
      'write_log("    " & dom.Name)
      Do While j <= dom.DistributionLists.Count - 1
         Set lstrcps = dom.DistributionLists.Item(j).recipients
         k = 0
         'write_log("      " & dom.DistributionLists.Item(j).address)
         Do While k <= lstrcps.count - 1
            Set rcp = lstrcps.item(k)
            'write_log("        " & rcp.recipientaddress)
            If Not InStr(1, lstadrs, rcp.recipientaddress) > 0 Then
               lstadrs = lstadrs & rcp.recipientaddress & "#"
            End If
            k = k + 1
         Loop
         j = j + 1
      Loop
      i = i + 1
   Loop
   
   If Len(lstadrs) > 1 Then
      lstadrs = Mid(lstadrs,1,Len(lstadrs) -1)
   End if
   lstadrsarr = Split(lstadrs,"#")
   i = 0
   Do While i <= UBound(lstadrsarr)
      Set nwl = whtlst.Add
      nwl.LowerIPAddress = "0.0.0.0"
      nwl.UpperIPAddress = "255.255.255.255"
      nwl.emailaddress = lstadrsarr(i)
      nwl.description = "zlst_" & lstadrsarr(i)
      nwl.Save
      'write_log("  adding " & lstadrsarr(i))
      i = i + 1
   Loop
   If UBound(lstadrsarr) > 0 then
      write_log("  Updating whitelist successful. Adding list members. Nr " & UBound(lstadrsarr) + 1)
   End if
End sub


Sub write_log(txt)
   'uses functions: get_date, nl
   'uses globals: logspath
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs
   Dim f
   
   Set fs = CreateObject("scripting.filesystemobject")
   
   Dim fn
   Dim tmp
    fn = logspath & "hmailserver_event_" & get_date & ".log"
   If dbg = True Then
      Set f = fs.opentextfile(fn, ForAppending, true)
      tmp = """" & FormatDateTime(Date + time,0) & """" & Chr(9) & """" & txt & """" & nl
      f.Write(tmp)
      f.close
   End If
End Sub

Function get_date
   Dim tmp
   Dim erg
   tmp = Year(Date)
   erg = CStr(tmp)
   
   If Month(Date) < 10 Then
      tmp = "0" & Month(Date)
   Else
      tmp = Month(Date)
   End If
   erg = erg & "-" & tmp
   
   If day(Date) < 10 Then
      tmp = "0" & day(Date)
   Else
      tmp = day(Date)
   End If
   erg = erg & "-" & tmp
   
   get_date = erg
End Function

Function nl
   nl = Chr(13) & Chr(10)
End function

westdam
Senior user
Senior user
Posts: 731
Joined: 2006-08-01 21:24
Location: Padova, Italy
Contact:

Re: Automatic whitelisting

Post by westdam » 2008-11-18 17:56

does it work on v5 too?

^DooM^
Site Admin
Posts: 13861
Joined: 2005-07-29 16:18
Location: UK

Re: Automatic whitelisting

Post by ^DooM^ » 2008-11-18 19:54

You could always just try it ;)
If at first you don't succeed, bomb disposal probably isn't for you! ヅ

westdam
Senior user
Senior user
Posts: 731
Joined: 2006-08-01 21:24
Location: Padova, Italy
Contact:

Re: Automatic whitelisting

Post by westdam » 2008-11-21 11:40

hehe sure , if i 'd have a v5 installation.

for a strange reason i dont have a v5 installed. even my test server it's on a v4 . :) i've just ask if someone has use it on a v5 yet..
i'll do the test in the weekend. i 'd like to pass to v5 on my own server .

mns17
Normal user
Normal user
Posts: 124
Joined: 2008-06-18 11:13

Re: Automatic whitelisting

Post by mns17 » 2008-11-24 12:28

it work on v5(313) !

luci
Normal user
Normal user
Posts: 70
Joined: 2008-02-29 14:29
Location: Romania

Re: Automatic whitelisting

Post by luci » 2008-12-01 14:06

I made some modifications to this script. I added domain exclusion support for major email provider or any other domain you want. If the recipient are local they are also excluded from the whitelist. There is no need to whitelist major email providers (they will be never blacklisted) or local accounts. This way the size of the whitelist file is smaller and file access faster allowing longer whitelisting periods. I found out that a large number of recipients from whitelist consists from major free email providers or local accounts.

Here is the modified script:

Code: Select all

Public obApp
Public Const iplocalhost = "0.0.0.0"
Public excluded_domains
excluded_domains = array("googlemail.com","gmail.com","hotmail.com","yahoo.com","yahoo.de","yahoo.fr","yahoo.it","lycos.co.uk","aol.com")
Public Const user = "Administrator"
Public Const pw = "secret"
public const dbg = true

Public Const remember_wl_address = 60
Public Const emailaddressesfile = "d:\Servers\hMailServer\Events\auto-whitelist.txt"
Public Const logspath = "d:\Servers\hMailServer\Logs\"

'Sub OnClientConnect(oClient)
'End Sub

'Sub OnDeliveryStart(oMessage)
'End Sub

'Sub OnDeliverMessage(oMessage)
'End Sub

'Sub OnBackupFailed(sReason)
'End Sub

'Sub OnBackupCompleted()
'End Sub

Sub OnAcceptMessage(oClient, oMessage)
   Set obApp = CreateObject("hMailServer.Application")
   Call obApp.Authenticate(user, pw)
   
   If oCLient.username <> "" Or oClient.IPAddress = iplocalhost Then
      write_log ("-->User has authenticated. User " & oCLient.username & ", Client " & oClient.IPAddress)
      register_emailadress oClient, oMessage
   End if
   
End Sub

sub register_emailadress(oClient, oMessage)
   'uses functions: get_smtp_recipient, update_whitelist
   'uses globals: emailaddressesfile, remember_wl_address
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs , f
   Set fs = CreateObject("scripting.filesystemobject")
   Dim ln
   Dim arr
   Dim fnd(2000)
   Dim fd
   Dim content
   Dim upd
   Dim erg
   Dim tmp
   upd = False
   
   Dim mailto
   Dim toarr
   Dim Domain_to
   Dim in_excluded
   
   Set obRecipients = oMessage.Recipients
   erg = ""
   For i = 0 to obRecipients.Count - 1
   Set obRecipient = obRecipients.Item(i)
   tmp = obRecipient.Address
   Domain_to = Split(lcase(tmp),"@")  

in_excluded = False

On Error Resume Next

' test to see if the domain and email are local. if local exclude it from whitelisting
   Dim obDomain
   Set obDomain = obApp.Domains.ItemByName(Domain_to(1))

if Err = 0 then
    Set obAccount = obDomain.Accounts.ItemByAddress(tmp)
    	if Err = 0 then
	   in_excluded = true
	end if   
end if

' Loop through all excluded domains and test if the recipient domain is in the excluded domains list
If not in_excluded Then
For each str in excluded_domains
	If Domain_to(1) = str Then
		in_excluded = True
		Exit For
	End If
Next
End If

     If not in_excluded Then	
     erg = erg & tmp & "#"      
     End if

   tmp = ""
   Next  
If erg <> "" Then
   erg = Mid(erg, 1, Len(erg) - 1)
   toarr = Split(lcase(erg),"#")

   content = ""
   For i = 0 To UBound(toarr)
      fnd(i) = False
   Next
   
   If fs.FileExists(emailaddressesfile) Then
      Set f = fs.OpenTextFile(emailaddressesfile, ForReading)
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         If ln <> "" Then
            arr = Split(ln,Chr(9))
            
            fd = false
            For j = 0 To UBound(toarr)
               mailto = toarr(j)
               If arr(0) = mailto Then
                  fd = True
                  fnd(j) = True
               End If
            Next
            If fd = True then
               write_log ("  adding to line " & ln)
               content = content & arr(0) & Chr(9) & arr(1) + 1 & Chr(9) & Date() & Chr(9) & CLng(Date()) & nl
            ElseIf CLng(arr(3)) < CLng(Date()) - remember_wl_address Then
               write_log ("  deleting line " & ln)
               upd = true
            Else
               content = content & ln & nl
            End If
         End if
      Loop
      f.Close
   End If
   
   For i = 0 To UBound(toarr)
      If fnd(i) = False Then
         content = content & toarr(i) & Chr(9) & 1 & Chr(9) & Date() & Chr(9) & CLng(Date()) & nl
         write_log ("  adding new line")
         upd = true
      End If
   next
   
   Set f = fs.OpenTextFile(emailaddressesfile, ForWriting, true)
   f.Write(content)
   write_log ("  writing emailaddressesfile")
   f.Close
   
   If upd = True Then
      update_whitelist
   End If
End If   
End Sub

Sub update_whitelist()
   'uses functions:
   'uses globals: obapp, emailaddressesfile
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Set fs = CreateObject("scripting.filesystemobject")
   Dim i
   Dim j
   Dim k
   Dim ln
   Dim arr
   Dim dom
   Dim lstrcps
   Dim rcp
   Set whtlst = obapp.Settings.AntiSpam.WhiteListAddresses
   Dim lstadrs
   lstadrs = ""
   Dim lstadrsarr
   
   i = whtlst.Count - 1
   Do While i >= 0
      Set wlo = whtlst.Item(i)
      If Mid(wlo.Description,1,5) = "zvbs_" Or Mid(wlo.Description,1,5) = "zlst_" Then
         whtlst.DeleteByDBID(whtlst.Item(i).id)
      End If
      i = i - 1
   loop
   
   If fs.FileExists(emailaddressesfile) Then
      Set f = fs.OpenTextFile(emailaddressesfile, ForReading)
      
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         arr = Split(ln,Chr(9))
         
         If UBound(arr) = 3 Then
            Set nwl = whtlst.Add
            nwl.LowerIPAddress = "0.0.0.0"
            nwl.UpperIPAddress = "255.255.255.255"
            nwl.emailaddress = arr(0)
            nwl.description = "zvbs_" & arr(0)
            nwl.Save
         End if
      Loop
      write_log("  Updating whitelist successful.")
   Else
      write_log("  Updating whitelist error: no emailadress file found.")
   End If
   
   i = 0
   Do While i <= obapp.Domains.Count - 1
      Set dom = obapp.Domains.Item(i)
      j = 0
      'write_log("    " & dom.Name)
      Do While j <= dom.DistributionLists.Count - 1
         Set lstrcps = dom.DistributionLists.Item(j).recipients
         k = 0
         'write_log("      " & dom.DistributionLists.Item(j).address)
         Do While k <= lstrcps.count - 1
            Set rcp = lstrcps.item(k)
            'write_log("        " & rcp.recipientaddress)
            If Not InStr(1, lstadrs, rcp.recipientaddress) > 0 Then
               lstadrs = lstadrs & rcp.recipientaddress & "#"
            End If
            k = k + 1
         Loop
         j = j + 1
      Loop
      i = i + 1
   Loop
   
   If Len(lstadrs) > 1 Then
      lstadrs = Mid(lstadrs,1,Len(lstadrs) -1)
   End if
   lstadrsarr = Split(lstadrs,"#")
   i = 0
   Do While i <= UBound(lstadrsarr)
      Set nwl = whtlst.Add
      nwl.LowerIPAddress = "0.0.0.0"
      nwl.UpperIPAddress = "255.255.255.255"
      nwl.emailaddress = lstadrsarr(i)
      nwl.description = "zlst_" & lstadrsarr(i)
      nwl.Save
      'write_log("  adding " & lstadrsarr(i))
      i = i + 1
   Loop
   If UBound(lstadrsarr) > 0 then
      write_log("  Updating whitelist successful. Adding list members. Nr " & UBound(lstadrsarr) + 1)
   End if
End sub


Sub write_log(txt)
   'uses functions: get_date, nl
   'uses globals: logspath
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs
   Dim f
   
   Set fs = CreateObject("scripting.filesystemobject")
   
   Dim fn
   Dim tmp
    fn = logspath & "hmailserver_event_" & get_date & ".log"
   If dbg = True Then
      Set f = fs.opentextfile(fn, ForAppending, true)
      tmp = """" & FormatDateTime(Date + time,0) & """" & Chr(9) & """" & txt & """" & nl
      f.Write(tmp)
      f.close
   End If
End Sub

Function get_date
   Dim tmp
   Dim erg
   tmp = Year(Date)
   erg = CStr(tmp)
   
   If Month(Date) < 10 Then
      tmp = "0" & Month(Date)
   Else
      tmp = Month(Date)
   End If
   erg = erg & "-" & tmp
   
   If day(Date) < 10 Then
      tmp = "0" & day(Date)
   Else
      tmp = day(Date)
   End If
   erg = erg & "-" & tmp
   
   get_date = erg
End Function

Function nl
   nl = Chr(13) & Chr(10)
End function
Radical Image Optimization Tool developer
Project Manager at CRIOSWEB

westdam
Senior user
Senior user
Posts: 731
Joined: 2006-08-01 21:24
Location: Padova, Italy
Contact:

Re: Automatic whitelisting

Post by westdam » 2008-12-03 18:26

cant get working on v5 314.
syntax is correct . on v4 it works.

any idea?

westdam
Senior user
Senior user
Posts: 731
Joined: 2006-08-01 21:24
Location: Padova, Italy
Contact:

Re: Automatic whitelisting

Post by westdam » 2008-12-03 18:28

mns17 wrote:it work on v5(313) !
how did you do?
i've got also the send email after backup successfully script enabled.


backup scritp goes well , this one no.

it's the same on v4.

westdam
Senior user
Senior user
Posts: 731
Joined: 2006-08-01 21:24
Location: Padova, Italy
Contact:

Re: Automatic whitelisting

Post by westdam » 2008-12-03 19:21

strange and weird.
till this afternoon doesnt work.

now i can see the ip address on the whitelist .
maybe cache on phpwebadmin.

forget all . all works now

andyp
Normal user
Normal user
Posts: 198
Joined: 2008-01-18 21:00

Re: Automatic whitelisting

Post by andyp » 2008-12-15 13:54

Avoid registering local domains was probably a good idea.

But I am unsure if the scripts works without the function get_smtp_recipient. The first time I programmed this script, I tried it the current way and encountered several difficulties. Afterwards I wrote the function get_smtp_recipient. The smtp recipients during the smtp session are different from the recipients collection in the api, martin confirmed that to me. You definetly have a different result.

Just want to mention: By removing this function, the installation instruction is obsolete.

Either way, in v5 there is another solution for this function, which is a lot better, and as I migrate to v5 on Christmas, I will migrate this script as well and provide the v5 script in a new topic.

The intention of this script was the automatic whitelisting of email addresses, which are in the distribution lists and also the addresses authenticated users send an email. By defining an excluded domain list, it won't register these addresses any more. Consequently a known email address can be blocked by hm spamfilter and the mail has to wait the greylist delay time until it passes the hm spamfilter. This doesn't meet the specification / intention, does it?

luci
Normal user
Normal user
Posts: 70
Joined: 2008-02-29 14:29
Location: Romania

Re: Automatic whitelisting

Post by luci » 2008-12-18 13:32

The intention of this script was the automatic whitelisting of email addresses, which are in the distribution lists and also the addresses authenticated users send an email. By defining an excluded domain list, it won't register these addresses any more. Consequently a known email address can be blocked by hm spamfilter and the mail has to wait the greylist delay time until it passes the hm spamfilter. This doesn't meet the specification / intention, does it?
The intention of whitelisting is to insure receiving from certain email addresses.
Whitelisting giant email providers is not necesarry because they will never be included in the blacklists. And if they will then we have a problem, because they are too big to be blocked.

Further more this option can be turned off if not needed. Simply put an empty array.
Having a big whitelist file increases access times.

Remember that many spammers use known email addresses to send just because they know about whitelisting.
Whitelisting an email address avoids SPAM checking including SPF and DNS blacklists. This way anyone can send spam using fake headers with a whitelisted email.
Radical Image Optimization Tool developer
Project Manager at CRIOSWEB

^DooM^
Site Admin
Posts: 13861
Joined: 2005-07-29 16:18
Location: UK

Re: Automatic whitelisting

Post by ^DooM^ » 2008-12-18 14:29

Whitelisting is used to prevent delay by greylisting.
If at first you don't succeed, bomb disposal probably isn't for you! ヅ

andyp
Normal user
Normal user
Posts: 198
Joined: 2008-01-18 21:00

Re: Automatic whitelisting

Post by andyp » 2008-12-18 17:26

luci, I concurr with the false headers used by spammers and the long process time for large files.

But the file won't be over lets say 500 kb (my is 13) and the os reads it in less than 25 ms maybe 50. If you watch the log, it takes a few seconds to sychronize the whitelist with the file and the distribution list. 50 maybe 100 ms for the file are not concerning at this moment.

The list contains only the addresses your accounts communicate with. A Spammer must know these addresses, how is he going to do that? I have never recieved a spam with a header and the exact address of one of my friends, maybe somename.something@web.de, but never my.friend@web.de. Would be quite a coincidence.

This automatic whitelisting script has nothing to do with blacklisting or not blacklisting the large domains, it simply guarentees none of your frequent used addresses - your accounts communicates with - is considered as spam or stuck in the delay of the greylist.

I have posted the script for hmailserver 5 in the appropiate board. It's performance is increased and you can also add addressbooks by pasting the addresses into the file. At my server I currently sychronize the withlist parallel to the eventhandler, this way the eventhandler is a lot faster and doesn't hold back the smtp connection. Will paste this awl_version2 when it works.

luci
Normal user
Normal user
Posts: 70
Joined: 2008-02-29 14:29
Location: Romania

Re: Automatic whitelisting

Post by luci » 2008-12-20 14:38

A Spammer must know these addresses, how is he going to do that?
Actually I seen many emails sent using my email address as From. This is my point of view - adding addresses to whilist increases the possiblity to receive SPAM and must be used with care. Adding email addresses that should never be tagged as spam (local accounts or giant providers) is useless and may lead to more SPAM.
About greylisting : I don't use it. Don't think spammers won't evolve soon to retry sending and defeaut greylisting. It's a matter of time...

Remember that my modifications are made according to my needs. I put these modifications here for people that may need to exclude a domain list or local accounts. If you don't think this option is good you can turn it off, but I think it would be good to include it in the next version of your script turned off by default. Some people may find it useful.
Radical Image Optimization Tool developer
Project Manager at CRIOSWEB

User avatar
mattg
Moderator
Moderator
Posts: 22437
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Automatic whitelisting

Post by mattg » 2008-12-20 15:39

luci wrote:About greylisting : I don't use it.
Ah, that then explains to me the differing viewpoints about exclusion of the giant mailservers from the global whitelist. Good idea to exclude them, unless you use greylisting; then bad idea, unless these giant mailservers are in the greylist/whitelist
luci wrote:Don't think spammers won't evolve soon to retry sending and defeaut greylisting. It's a matter of time...
I'm not so certain.

Greylisting as a concept isn't new. I suspect many spammers are too scared of being caught to try sending again, and they just send once and then keep running and hiding; running and hiding...bastards.

But if they do evolve, well then we can just make the greylist get three knocks on the door, rather than the current two before we allow delivery. We could also build in some form of SPAM trapping into the greylist wait period...
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

luci
Normal user
Normal user
Posts: 70
Joined: 2008-02-29 14:29
Location: Romania

Re: Automatic whitelisting

Post by luci » 2008-12-22 19:14

But if they do evolve, well then we can just make the greylist get three knocks on the door, rather than the current two before we allow delivery.
Then 4,5,6 and so on... until we put a heavy load on servers just for few messages. I don't think a spammer cares how many times it needs to retry... remember - he's a spammer - that's what he does - it sends many emails. It does not have a problem with retry. Actually you can see already that many of them of retrying.

The most efficient anti-spam methods are in fact SPF and domain keys. This is the only way to isolate spam. Having server to retry on each email several times breaks the ideea of instant communication I really liked until greylisting appeared.

We should move to another topic to discuss about spam. :)
Radical Image Optimization Tool developer
Project Manager at CRIOSWEB

^DooM^
Site Admin
Posts: 13861
Joined: 2005-07-29 16:18
Location: UK

Re: Automatic whitelisting

Post by ^DooM^ » 2008-12-23 01:01

I disagree. Greylisting has worked extremely well on my servers and has cut spam down by 80%. Yes some spammers retry because they find compromised mailservers to send email through and they RETRY. The usual botnet spammers do not however retry, they open a socket, force feed the email and disregard. This is the attack greylisting combats. It is not the answer to spam by all means it is just another tool to be used along with SPF, Domain Keys, RBL's and tarpitting. While you have a problem with greylisting many users do not.
If at first you don't succeed, bomb disposal probably isn't for you! ヅ

andyp
Normal user
Normal user
Posts: 198
Joined: 2008-01-18 21:00

Re: Automatic whitelisting

Post by andyp » 2008-12-23 14:07

luci, if you don't use greylisting the exception for large providers are a good idea. I still wouldn't use exceptions with greylisting switched on, unless you don't care if your incoming mail stucks behind the greylist delay time.

Either way greylisting has reduced the spam from 10 spam to 1-2 spams.

luci
Normal user
Normal user
Posts: 70
Joined: 2008-02-29 14:29
Location: Romania

Re: Automatic whitelisting

Post by luci » 2009-01-03 10:22

What about false positives? Did you had any with greylisting switched on?
Radical Image Optimization Tool developer
Project Manager at CRIOSWEB

User avatar
mattg
Moderator
Moderator
Posts: 22437
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Automatic whitelisting

Post by mattg » 2009-01-03 11:42

luci wrote:What about false positives? Did you had any with greylisting switched on?
I have had none that I am aware of in nearly two years, one domain about 40 accounts.

But then other than from user feedback, how would we know?

We deal with very sensitive personal information, much of it is encrypted, and there are third party tracking systems in place. I have never been advised of 'missed' email that I couldn't explain by some other system fault...
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

^DooM^
Site Admin
Posts: 13861
Joined: 2005-07-29 16:18
Location: UK

Re: Automatic whitelisting

Post by ^DooM^ » 2009-01-03 13:52

I have had the same experience as mattg. While I have had people contact me because of delayed email, I have never had anyone contact me about missing email that was down to greylisting in the 2+ years I have used it.
If at first you don't succeed, bomb disposal probably isn't for you! ヅ

luci
Normal user
Normal user
Posts: 70
Joined: 2008-02-29 14:29
Location: Romania

Re: Automatic whitelisting

Post by luci » 2009-01-13 15:52

Based on your experiences and after some readings I turned on greylisting. So far only one customer complained about not receiving emails and asked me to turn off this feature.

I keep my oppinion on don't doing global whitelisting for major email providers. I think it's a better ideea to maintain a greylisting whitelist with their IPs. The possibility to receive emails from spammers with fake google or yahoo headers is very high. Whitelisting only valid IPs eliminates this problem.
Radical Image Optimization Tool developer
Project Manager at CRIOSWEB

JoNtheOueB
New user
New user
Posts: 29
Joined: 2006-05-11 20:07
Location: FRANCE (Marne La Vallée - 77)
Contact:

Re: Automatic whitelisting

Post by JoNtheOueB » 2009-07-09 14:03

When I use this script, the CPU of my server is at 100% during approximatively 15 seconds for each mail, is it the same for you ?
JoN ;)

^DooM^
Site Admin
Posts: 13861
Joined: 2005-07-29 16:18
Location: UK

Re: Automatic whitelisting

Post by ^DooM^ » 2009-07-09 14:19

No this doesn't happen to me. Are you using Clamwin?
If at first you don't succeed, bomb disposal probably isn't for you! ヅ

User avatar
synx01
New user
New user
Posts: 11
Joined: 2009-06-19 16:45

Re: Automatic whitelisting

Post by synx01 » 2010-02-09 05:51

Does anyone know of a way to modify the script to act on a domain level as opposed to individual email addresses? That would be helpful. There are handful of emails that go out to particular companies and I'd rather have this as a single entry rather than 3+.

Thanks People!

User avatar
mattg
Moderator
Moderator
Posts: 22437
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Automatic whitelisting

Post by mattg » 2010-02-09 06:56

If you whitelist entire domains with a script, won't you just be adding all domains very quickly.

If you only have a few companies that you want to whitelist, add them manually via the GUI
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

User avatar
synx01
New user
New user
Posts: 11
Joined: 2009-06-19 16:45

Re: Automatic whitelisting

Post by synx01 » 2010-02-12 19:29

The reason I was asking if it would be possible to modify the script to whitelist domain level additions (*@company.com) is because I already have 900 new entries in 4 days. I'm sure I have several different contacts at company.com that are in the list and it'd be nice to narrow...lets say 9 entries to 1 entry. Most of my manual entries I do are for the entire domain anyway.

Post Reply