Script to log Recipient Addresses

This section contains scripts that hMailServer has contributed with. hMailServer 5 is needed to use these.
Post Reply
SteffenM
Normal user
Normal user
Posts: 108
Joined: 2013-09-02 19:54

Script to log Recipient Addresses

Post by SteffenM » 2015-03-14 16:28

Hi,

I wrote a small script to log the Recipient Addresses of emails delivered via SMTP to hMailServer. I use it to look which addresses are used and how often. I used catchall at the past and do not know any address I am using. So the script generates a textfile like this (the number after the comma shows how often this address is used) :

Code: Select all

address1@domain1.net,3
address2@domain1.net,5
address1@domain2.net,2
Here is the code to insert at the EventHandlers.vbs:

Code: Select all

Public Const HMSDIR = "c:\hMailServer\"   'Path to hMailServer-Dir

...

Sub OnAcceptMessage(oClient, oMessage)

	Dim objRecipient
	Dim strAddress
		
	On Error Resume Next
	Err.Clear

	For objRecipient = 0 to oMessage.Recipients.Count-1
		strAddress = LCase(oMessage.Recipients(objRecipient).Address)
		LogRecipient strAddress
	Next

End Sub

...

Sub LogRecipient(strNewAddress)

	Dim oFSO, tsDatei
	Dim strLogFile, strValueAddress, strValueCount
	Dim strNew, strTemp
	Dim booUpdate
	
	On Error Resume Next
	Err.Clear
	
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	strLogFile = HMSDIR & "Logs\hmailserver_Reciptions.log"
	strNew = ""
	booUpdate = False
	
	If IsFileExists(strLogFile) = True Then
	
		Set tsDatei = oFSO.OpenTextFile(strLogFile, 1)
		
		Do Until tsDatei.AtEndOfStream
			strTemp = tsDatei.ReadLine
			strValueAddress = Mid(strTemp,1,InStr(1,strTemp,",")-1)
			strValueCount = Mid(strTemp,InStr(1,strTemp,",")+1)
			If strValueAddress = strNewAddress Then
				strValueCount = CStr(CInt(strValueCount) + 1)
				booUpdate = True
			End If
			strNew = strNew & strValueAddress & "," & strValueCount & vbCrLf
		Loop
		tsDatei.Close
		
		If booUpdate = False Then
			strNew = strNew & strNewAddress & ",1" & vbCrLf
		End If
		
		Set tsDatei = oFSO.OpenTextFile(strLogFile, 2)
		tsDatei.Write strNew
		tsDatei.Close
		
	Else
		
		Set tsDatei = oFSO.CreateTextFile(strLogFile, True)
		tsDatei.WriteLine(strNewAddress & ",1")
		tsDatei.Close
		
	End If
	
	Set tsDatei = Nothing
	Set oFSO = Nothing

End Sub
Have fun, Steffen

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

Re: Script to log Recipient Addresses

Post by jimimaseye » 2015-03-14 16:56

So this is listing both recipients for INCOMING (ie, yourdomain) AND outgoing (ie, who youre sending TO) recipients?
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

SteffenM
Normal user
Normal user
Posts: 108
Joined: 2013-09-02 19:54

Re: Script to log Recipient Addresses

Post by SteffenM » 2015-03-14 16:59

Only INCOMING via SMTP!

Steffen

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

Re: Script to log Recipient Addresses

Post by jimimaseye » 2015-03-14 17:21

I just tried it and it completely stops my HMS from accepting outgoing messages.

With the script in place, my email client can no longer send a message (it simply freezes at 'Delivering email....") and requires to abort. If I REM' the function call to "LogRecipient strAddress" then it then works again (but obviously your scrip is no longer called).

The same thing happens on INCOMING message. The log shows a Freeze/loop at the DATA command and the message it never received.

So there is something fundamentally wrong here.
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

SteffenM
Normal user
Normal user
Posts: 108
Joined: 2013-09-02 19:54

Re: Script to log Recipient Addresses

Post by SteffenM » 2015-03-14 17:28

I do not know how you insert it at the hMS-EventHandler?!

Here this script is working fine since several weeks without a problem and of course with a mailing hMS!

Steffen

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

Re: Script to log Recipient Addresses

Post by jimimaseye » 2015-03-14 18:08

ok, I found the problem.

The problem was the CREATION of the Recipient log file - the code sinmply stalled/froze/was unable to create the file if it doesnt exist (I havent looked in to why). However, once I MANUALLY created the file (as an empty file) it all then worked ok.

You sure that section of the code (to create the log file if it doesnt exist) is correct?

BY THE WAY... when you say INBOUND - I assume you mean inbound to the server irrespective of whether it is being delivered to the domain from external email or being sent from an internal user, being delivered to the server for sending out to an external. Because that is what happens with "OnAcceptMessage(oClient, oMessage)".

ie, You will receive email addresses of both internal users that have received email from outside, and of external users that have been sent emails from you accounts.
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

SteffenM
Normal user
Normal user
Posts: 108
Joined: 2013-09-02 19:54

Re: Script to log Recipient Addresses

Post by SteffenM » 2015-03-14 18:44

Here the script can create the file if the directory exist!
Do you have a security problem? Have customize the home-path?

You can look at the docu when the event is fired:

OnAcceptMessage Executed when an e-mail has been delivered to the server using the SMTP protocol.

Then I get the recipients and log they to the file. That's it!

I'm use hMS not for sending only for incoming mail gateway. But you can customize the script in any way you like the function, thats the reason why I post the script!


Steffen

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

Re: Script to log Recipient Addresses

Post by jimimaseye » 2015-03-14 18:56

My install, security and locations are default. Hmailserver is run as LOCAL SYSTEM.

The thing is this: the script may or may not be correct in its coding for creating the file from scratch, and the cause for the failing here may not be clear. The point of me posting the problem (and solution) was to highlight that if it happens to me (with a standard install) it is highly likely it can happen to others too and that they need to be aware of it.

So, to be sure my advice is to create the file manually. User should note the script supplied actually has the filename coded as

Code: Select all

"Logs\hmailserver_Reciptions.log"
(You can of course change it to "hmailserver_Recipients.log" or whatever you like - as long as the file is called the same.
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

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

Re: Script to log Recipient Addresses

Post by SorenR » 2015-03-14 20:06

It's a nice little script... BUT... It has some problems!

First, it should ONLY run on incoming emails. I assume clients are required to authenticate, thus we can do this:

Code: Select all

Sub OnAcceptMessage(oClient, oMessage)

   If (oClient.Username = "") Then

      Dim objRecipient
      Dim strAddress
      
      On Error Resume Next
      Err.Clear

      For objRecipient = 0 to oMessage.Recipients.Count-1
         strAddress = LCase(oMessage.Recipients(objRecipient).Address)
         LogRecipient strAddress
      Next

   End If

End Sub
Second, there is no check if the records file is in use. If emails are received concurrently, it WILL fail with Err.Number = 70 as both (or more) sessions try to read from/write to the file at the same time. You just can't see the error due to "On Error Resume Next" :roll:

I guess for a low volume server it should be OK.
SørenR.

“With age comes wisdom, but sometimes age comes alone.”
- Oscar Wilde

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

Re: Script to log Recipient Addresses

Post by jimimaseye » 2015-03-15 17:12

SorenR wrote:It's a nice little script... BUT... It has some problems!

First, it should ONLY run on incoming emails.
In its current form it logs the recipients of all addresses. Could be useful. For example, it could then be used as analysis at the end of the year and imported to create a mailing list of email addresses (for send email christmas card for example)

SorenR wrote:Second, there is no check if the records file is in use. If emails are received concurrently, it WILL fail with Err.Number = 70 as both (or more) sessions try to read from/write to the file at the same time. You just can't see the error due to "On Error Resume Next" :roll:

I guess for a low volume server it should be OK.
Couldnt you code something like:
Access record file
if Err.Number = 70 then '(file is locked)
go back and try again
This way it will loop round trying to gain access until the other locking process reliquishes its hold (should be milliseconds, no?)


I also want to correct the error that caused the failure to CREATE the log file (if it didnt exist)

Currently the sub routine reads:

Code: Select all

Set oFSO = CreateObject("Scripting.FileSystemObject")
   strLogFile = HMSDIR & "Logs\hmailserver_Reciptions.log"
   strNew = ""
   booUpdate = False
   
   If IsFileExists(strLogFile) = True Then
that last line is incorrect and should read:

Code: Select all

 If oFSO.FileExists(strLogFile) = True Then
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

SteffenM
Normal user
Normal user
Posts: 108
Joined: 2013-09-02 19:54

Re: Script to log Recipient Addresses

Post by SteffenM » 2015-03-15 17:34

IsFileExists is a generic Function in my library. I forgot to list this:

Code: Select all

Function IsFileExists(strFile)
	
	Dim oFSO
	
	On Error Resume Next
	Err.Clear
	
	IsFileExists = False
	
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FileExists(strFile) Then
		IsFileExists = True
	End If 
	

	Set oFSO = Nothing
	
End Function
@SorenR: Thanks for your hints! I work on a version with a better timing and blocking the log-file so should no problem with concurrently received mails!

Steffen

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

Re: Script to log Recipient Addresses

Post by SorenR » 2015-03-15 19:53

SteffenM wrote:@SorenR: Thanks for your hints! I work on a version with a better timing and blocking the log-file so should no problem with concurrently received mails!

Steffen
I posted how I've done the "concurrent" write to file in another thread, perhaps you can used that as inspiration..

viewtopic.php?f=7&t=27935&p=173422#p173422
SørenR.

“With age comes wisdom, but sometimes age comes alone.”
- Oscar Wilde

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

Re: Script to log Recipient Addresses

Post by jimimaseye » 2015-03-15 21:42

SteffenM wrote:IsFileExists is a generic Function in my library. I forgot to list this:
That'll explain it then. That'll be why the initial script froze the program then. :-)
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

SteffenM
Normal user
Normal user
Posts: 108
Joined: 2013-09-02 19:54

Re: Script to log Recipient Addresses

Post by SteffenM » 2015-03-16 12:43

Here is the new version - better handling with the log-file, better logging (first and last occur) and many bugfixes:

Code: Select all


' **********************************************************************
' *** Global Settings
' **********************************************************************

Public Const HMSDIR = "d:\Server\hMailServer\"   ' hMailServer Directory
Public Const HMSUSER = "Administrator"           ' hMailServer Admin User
Public Const HMSPW = "password"                  ' hMailServer Password

Public Const DEBUGLOG = False                    ' Enable EventLog Logging

' **********************************************************************
' *** hMailServer Events
' **********************************************************************

Sub OnAcceptMessage(oClient, oMessage)

	If oClient.Username = "" Then   ' Ignore messages from local users

		Dim objRecipient
		Dim strAddress
			
		On Error Resume Next
		Err.Clear
	
		For objRecipient = 0 to oMessage.Recipients.Count-1
			strAddress = LCase(oMessage.Recipients(objRecipient).OriginalAddress)
			LogRecipient strAddress
		Next
	
	End If

	If Err.Number <> 0 Then
		EventLog.Write("OnAcceptMessage: -ERR " & Err.Number & " " & Err.Description)
	Else
		If DEBUGLOG = True Then
			EventLog.Write("OnAcceptMessage: +OK")
		End If
	End If

End Sub

' **********************************************************************
' *** Application Subs and Functions
' **********************************************************************

Sub LogRecipient(strNewAddress)

	Dim oFSO, tsDatei
	Dim strLogFile, strNew, strOld, strTemp
	Dim arrOldLines, arrTemp
	Dim intI
	Dim booUpdate
	
	On Error Resume Next
	Err.Clear
	
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	strLogFile = HMSDIR & "Logs\hmailserver_Reciptions.log"
	strNew = ""
	booUpdate = False
	
	If IsFileExists(strLogFile) = True Then
	
		Set tsDatei = oFSO.OpenTextFile(strLogFile, 1)
		strOld = tsDatei.ReadAll   ' ReadAll to quick close and block to write
		tsDatei.Close
		Set tsDatei = Nothing
		
		For intI = 0 To 30
			Set tsDatei = oFSO.OpenTextFile(strLogFile, 2)   ' Block the file for other processes
			If Err.Number = 0 Then   ' File is open
				Exit For
			End If
			If Err.Number = 70 Then   ' File is blocked, try again
				On Error Goto 0
				WScript.Sleep 1000
			Else   ' Error, File can not open
				EventLog.Write("LogRecipient: File can not open -ERR " & Err.Number & " " & Err.Description)
				Set tsDatei = Nothing
				Set oFSO = Nothing
				Exit Sub
      			End If
    		Next
    	
    		If intI = 30 And Err.Number = 70 Then   ' File can not open after 30 seconds
			EventLog.Write("LogRecipient: File can not open after 30 seconds -ERR " & Err.Number & " " & Err.Description)
			Set tsDatei = Nothing
			Set oFSO = Nothing
			Exit Sub
    		End If

		arrOldLines = Split(strOld, vbCrLf)
    		For Each strTemp in arrOldLines
    			If strTemp <> "" Then
    				arrTemp = Split(strTemp, ",")
    				If arrTemp(1) = strNewAddress Then
    					strNew = strNew & arrTemp(0) & "," & arrTemp(1) & "," & Now & "," & CStr(CInt(arrTemp(3)) + 1) & vbCrLf
    					booUpdate = True
    				Else
    					strNew = strNew & strTemp  & vbCrLf
    				End If
			End If
    		Next
		
		If booUpdate = False Then
			strNew = strNew & Now & "," & strNewAddress & "," & Now & ",1" & vbCrLf
		End If
		
		tsDatei.Write strNew
		tsDatei.Close
		
	Else
		
		Set tsDatei = oFSO.CreateTextFile(strLogFile, True)
		tsDatei.WriteLine("CreatedAt,RecipientAddress,LastModifiedAt,Frequency")
		tsDatei.WriteLine(Now & "," & strNewAddress & "," & Now & ",1")
		tsDatei.Close
		
	End If
	
	Set tsDatei = Nothing
	Set oFSO = Nothing

	If Err.Number <> 0 Then
		EventLog.Write("LogRecipient: -ERR " & Err.Number & " " & Err.Description)
	Else
		If DEBUGLOG = True Then
			EventLog.Write("LogRecipient: +OK")
		End If
	End If
			
End Sub

' **********************************************************************
' *** Global Subs and Functions
' **********************************************************************

Function IsFileExists(strFile)
	
	Dim oFSO
	
	On Error Resume Next
	Err.Clear
	
	IsFileExists = False
	
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FileExists(strFile) Then
		IsFileExists = True
	End If 
	
	If Err.Number <> 0 Then
		EventLog.Write("IsFileExists: -ERR " & Err.Number & " " & Err.Description)
	Else
		If DEBUGLOG = True Then
			EventLog.Write("IsFileExists: +OK")
		End If
	End If
	Set oFSO = Nothing
	
End Function
Have Fun,
Steffen

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

Re: Script to log Recipient Addresses

Post by jimimaseye » 2015-03-16 13:00

Certainly looks more detailed and controlling.

I completely removed the original script an hour ago because for some reason it sent my hmailserver process into a loop and all mail stopped. (I will leave feedback on this version to others)
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

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

Re: Script to log Recipient Addresses

Post by SorenR » 2015-03-16 13:01

"WScript.Sleep 1000" will not work as the script is not run in a Command Shell.

hMailServer contain its own Active Script Engine Wrapper, so direct interaction with a Command Shell is not possible. That's why I had to make the wait() function.

Code: Select all

      Public Function Wait(sec)
         t = Timer
         Do While ((Timer - t) < sec) Xor (Timer < t)
         Loop
      End Function
The "Xor (Timer < t)" part is to compensate for midnight. In rare cases the wait could be as long as 23:59:59.999 ;-)
SørenR.

“With age comes wisdom, but sometimes age comes alone.”
- Oscar Wilde

SteffenM
Normal user
Normal user
Posts: 108
Joined: 2013-09-02 19:54

Re: Script to log Recipient Addresses

Post by SteffenM » 2015-03-16 13:13

OK+Thanks! I changed this and at your function to my global subs!

Steffen

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

Re: Script to log Recipient Addresses

Post by jimimaseye » 2015-03-16 13:19

SorenR wrote:"WScript.Sleep 1000" will not work as the script is not run in a Command Shell.
Confirmed. Just tried it.

Code: Select all

Sub OnClientConnect(oClient)
   wscript.sleep 10000
End Sub
results in this:

Code: Select all

"ERROR"	4972	"2015-03-16 11:06:00.775"	"Script Error: Source: Microsoft VBScript runtime error - Error: 800A01A8 - Description: Object required: 'wscript' - Line: 12 Column: 0 - Code: (null)"
Maybe not the error you were expecting, but nonetheless it fails.

However, I test Sorens function with:

Code: Select all

   Sub OnClientConnect(oClient)
	        t = Timer
         Do While ((Timer - t) < 10) Xor (Timer < t)
         Loop
   End Sub
and indeed it works (client connecting to send email gets delayed 10 seconds, as expected).
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