mailbox size warning

This forum contains features that has been archived. This section contains implemented features, duplicate requests, and requests which we have decided not to implement.
Post Reply

Do you need this feature?

Yes
23
96%
No
1
4%
 
Total votes: 24

tomaste
Normal user
Normal user
Posts: 55
Joined: 2004-06-14 17:20

mailbox size warning

Post by tomaste » 2005-05-31 15:58

It would be great if the mail server would send a warning to a mailbox if its size was approaching its limit. The warning threshhold should be able to be admin definable based on percentage full. Example:

When mailbox is 90% (or greater) full, autosend message "Warning! Your mailbox is XX% full. If your mailbox reaches 100% full, mail will no longer be delivered to your account."

The mesage should be admin definable also. Some sort of setting to limit the amount of messages to be sent should also be included. Such as, send warning once a day, once a week, etc..

cmurphy54
Senior user
Senior user
Posts: 550
Joined: 2004-09-25 22:11
Location: Atlanta, GA
Contact:

Post by cmurphy54 » 2005-06-02 20:45

I agree this would be a nice feature to have integrated into the admin panel.

In the meantime, here's a script that offers most of the functionality above except for the only sending every day, week, etc. That wouldn't be hard to add, you'd just need to persist that a mail was sent somehow.

Code: Select all


Dim DebugLog

'**************User Defined Constants***************************
'Log Directory Where Debug log is stored
Const conLogDir = "D:\Program Files\hMailServer\Logs\"
'Percentage of space remaining when warning messages get sent
Const conSpaceRemainingWarningAt = 0.05
'Email Address that warning emails appear to be from
Const conSpaceWarningFrom = "admin@pcyoudo.com"
Const conSpaceWarningSubject = "Email storage limit almost reached"
Const conSpaceWarningBody = "[address],  \n\nYour mailbox size of [size] MB is within 5% of its maximum space allotment of [maxsize] MB. In order to avoid bounced messages, please consider reducing the size of your mailbox. \n\nThanks,\n\nAdministrator"
'If True, debug log is created to help debug
Const conDebug = False

'***************************************************************

'***************************************************************
'InitializeVariables: Initialize global variables 
'
'***************************************************************
Sub InitializeVariables
	'Create our debug logger
	Set DebugLog = new DebugLogger
	'Set whether it is enabled or not
	DebugLog.IsEnabled = conDebug
End Sub

'   Sub OnClientConnect(oClient)
'   End Sub

'   Sub OnAcceptMessage(oClient, oMessage)
'   End Sub

Sub OnDeliverMessage(oMessage)
	'Initialize our global variables
	InitializeVariables
	DebugLog.LogWithTimestamp "Entering OnDeliverMessage", DebugLog.IncreaseIndent
	
	DoMailboxSizeLimitWarning( oMessage )
	
	DebugLog.Log "Exiting OnDeliverMessage. Result.Value = " & Result.Value, DebugLog.DecreaseIndent
	'Cleanup our variables
	DisposeVariables	
End Sub

'***************************************************************
'***************************************************************
'						Mailbox Limit Approaching Functionality
'***************************************************************
'***************************************************************

Sub DoMailboxSizeLimitWarning( oMessage )
	DebugLog.Log "Entering DoMailboxSizeLimitWarning", DebugLog.IncreaseIndent
	Dim oAccount
	
	Dim messageBody
	
	Set oAccount = new Account

	'Check to make sure the message we're checking against 
	'isn't a warning message. Otherwise we'll get stuck in an
	'endless mail sending loop
	If oMessage.Subject <> conSpaceWarningSubject Then
		'Loop through all the mail recipients
		For i = 0 To oMessage.Recipients.Count - 1
			DebugLog.Log "Recipient: " & oMessage.Recipients(i).Address, null
			'Check to see if recipient is local
			If Recipients(i).IsLocalUser Then
				'if so, let's load their account to get their mailbox info
				oAccount.LoadAccountFromAddress( oMessage.Recipients(i).Address )
				'Is the mailbox approaching the threshold specified?
				If oAccount.IsMailboxWithinXPercentOfLimit(conSpaceRemainingWarningAt) Then
						'Customize our warning message for this user
						messageBody = conSpaceWarningBody
						messageBody = Replace( messageBody, "\n", vbCRLF )
						messageBody = Replace( messageBody, "[address]", oAccount.Address )
						messageBody = Replace( messageBody, "[maxsize]", oAccount.MaxSize )
						messageBody = Replace( messageBody, "[size]", oAccount.Size )
						'Send warning message
						DebugLog.Log "Sending Warning Message to " & oAccount.Address, null
						SendMessage conSpaceWarningFrom, Array( oAccount.Address ), conSpaceWarningSubject, messageBody
				End If
			End If
		Next	
	End If
	
	Set oAccount = Nothing
	DebugLog.Log "Exiting DoMailboxSizeLimitWarning", DebugLog.DecreaseIndent
End Sub

'***************************************************************
'DisposeVariables: Clean up any variables we might have been using
'
'***************************************************************
Sub DisposeVariables
	DebugLog.Dispose
	Set DebugLog = Nothing
End Sub



'*****************************************************************************
'***************************** Helper Classes ********************************
'*****************************************************************************
'*****************************************************************************
Class Account
	Dim oAccount

	Public Property Get Address
		Address = oAccount.Address
	End Property

	Public Property Get MaxSize
		MaxSize = oAccount.MaxSize
	End Property
	
	Public Property Get Size
		Size = oAccount.Size
	End Property

	Function IsMailboxWithinXPercentOfLimit( dblPercent )
		DebugLog.Log "Entering IsMailboxWithinXPercentOfLimit dblPercent: " & dblPercent, DebugLog.IncreaseIndent
		DebugLog.Log "Current MB Size: " & Size & "  Max MB Size: " & MaxSize & "  Warning Size: " & MaxSize * dblPercent, null
		
		If MaxSize = 0 Then	DebugLog.Log "Account has no storage limit! Returning false", null

		'Perform our calc, a MaxSize of 0 means there is no max size, so
		'in that case we'll always return false
		If( MaxSize > 0 And MaxSize * dblPercent < Size ) Then 
			IsMailboxWithinXPercentOfLimit = True
		Else
			IsMailboxWithinXPercentOfLimit = False
		End If
		DebugLog.Log "Exiting IsMailboxWithinXPercentOfLimit. Return value: " & IsMailboxWithinXPercentOfLimit, DebugLog.DecreaseIndent
	End Function

	Sub LoadAccountFromAddress( strAddress )
		Dim oDomains
		Dim oDomain
		Dim oAccounts
		Dim strDomain 

		DebugLog.Log "Entering LoadAccountFromAddress, strAddress = " & strAddress, DebugLog.IncreaseIndent

		DebugLog.Log "Creating Domains Object", null
		Set oDomains = CreateObject("hMailServer.Domains")
		DebugLog.Log "Created Domains Object", null
	
		strDomain = Right( strAddress, Len( strAddress ) - InStr(strAddress, "@") )
		DebugLog.Log "Domain from address is: " & strDomain, null
		
		Set oDomain = oDomains.ItemByName( strDomain )
				
		DebugLog.Log "Creating Accounts Object", null
		Set oAccounts = oDomain.Accounts
		DebugLog.Log "Created Accounts Object", null
		DebugLog.Log "Getting Account: " & strAddress, null
		
    ' Enable error handling
    On Error Resume Next

		Set oAccount = oAccounts.ItemByAddress(strAddress)
		DebugLog.LogError

    ' Reset error handling
    On Error Goto 0		
		DebugLog.Log "Got Account: " & oAccount.Address, null
		Set oAccounts = Nothing
		Set oDomains = Nothing
		Set oDomain = Nothing
		DebugLog.Log "Exiting LoadAccountFromAddress", DebugLog.DecreaseIndent
	End Sub

End Class

Function SendMessage( strFrom, arrRecipients, strSubject, strBody )
	DebugLog.Log "Entering SendMessage strFrom = " & strFrom & " arrRecipients = " &_
		 Join(arrRecipients," : ") & " strSubject = " & strSubject & " strBody = " & strBody, DebugLog.IncreaseIndent

	Dim oMessage
	Set oMessage = CreateObject("hMailServer.Message")
	
	oMessage.From = strFrom
	oMessage.Subject = strSubject

	Dim arrRecipientParts
		
	For Each recipient in arrRecipients
		arrRecipientParts = Split( recipient, "," )
		If( UBound( arrRecipientParts ) > 1 ) Then
			oMessage.AddRecipient arrRecipientParts(0), arrRecipientParts(1)
		Else
			oMessage.AddRecipient "", arrRecipientParts(0)
		End If
	Next
	
	oMessage.Body = strBody
	oMessage.Save

	Set oMessage = Nothing
	DebugLog.Log "Exiting SendMessage", DebugLog.DecreaseIndent
End Function

'***************************************************************
'DebugLogger: A class to log debug messages. Logging only works 
' if IsEnabled = true, otherwise all logging calls are ignored
'***************************************************************
Class DebugLogger

	Private m_intIndent
	Private m_blnIsEnabled
	
	Public Property Get IsEnabled 
		IsEnabled = m_blnIsEnabled 
	End Property
	
	Public Property Let IsEnabled(ByVal blnValue)
		m_blnIsEnabled = blnValue
	End Property
	
	Public Property Get DecreaseIndent
		DecreaseIndent = -1
	End Property

	Public Property Get IncreaseIndent
		IncreaseIndent = 1
	End Property
	
	Private Property Get LogDir
		LogDir = conLogDir
	End Property
	
	Private Property Get Indent
		If m_intIndent = "" Then 
			m_intIndent = 0
		End If
			
		Indent = m_intIndent
	End Property
	
	Private Property Let Indent(ByVal intValue)
		m_intIndent = intValue
	End Property
	
	Sub Dispose
	
	End Sub
	
	Private Sub IncIndent
			Indent = Indent + 1
	End Sub
	
	Private Sub DecIndent
		If Indent > 0 Then
			Indent = Indent - 1
		End If
	End Sub
	
	Sub LogError
     If Err.number <> 0 Then
          ' Object couldn't be created

          ' Log error
          Log "**Error: Description: " & Err.Description & "  Severity: " & apgSeverityError & "  Number: " & Err.Number, null
     End If	
	End Sub
	
	Sub LogWithTimestamp( strString, intIndentType )
		Log Date & " " & Time & "  " & strString, intIndentType
	End Sub
	
	Sub Log( strString, intIndentType )
		If IsEnabled Then
			'We decrease indent immediately
			If intIndentType = DecreaseIndent Then
				DecIndent
			End If
		
		  SET oFs = CreateObject("Scripting.FileSystemObject") 
		  SET oFil = ofs.OpenTextFile( LogDir & "Debug.log", 8, True) 
		  For i = 0 To Indent
		  	oFil.write("  ")
			Next
		  oFil.WriteLine( strString ) 
		  oFil.Close 
		  SET oFil = Nothing 
		  SET oFs = Nothing 
		  
			'We increase indent after
			If intIndentType = IncreaseIndent Then
				IncIndent
			End If
		  
		End If
	End Sub

End Class

'***************************************************************
'Logger: Logging class to log whatever to a log file
'	Copied/Modified from mnadig's post 
'	(http://www.hmailserver.com/forum/viewtopic.php?t=1798)
'***************************************************************
Class Logger

	Private Property Get LogDir
		LogDir = conLogDir
	End Property	
	
	Sub WriteLog( strString ) 
	  SET oFs = CreateObject("Scripting.FileSystemObject") 
	  SET oFil = ofs.OpenTextFile( LogDir & "Events.log", 8, True) 
	  oFil.writeline( strString) 
	  oFil.close 
	  SET oFil = Nothing 
	  SET oFs = Nothing 
	End Sub

End Class

lbs
New user
New user
Posts: 26
Joined: 2006-02-14 01:27

Post by lbs » 2006-02-18 00:09

Great script ! Thank you. There are very few features from commercial products still missing in hMailServer.

Your server is definitively an excellent work, martin !

lbs
New user
New user
Posts: 26
Joined: 2006-02-14 01:27

Post by lbs » 2006-02-18 00:09

Great script ! Thank you. There are very few features from commercial products still missing in hMailServer.

Your server is definitively an excellent work, martin !

User avatar
Slug
Moderator
Moderator
Posts: 1369
Joined: 2005-03-13 05:42
Location: Sydney Australia
Contact:

Post by Slug » 2006-02-18 17:21

Gee you are impressed lbs .. said it twice :-)
Missing Hmailserver ... Now running Debian servers

timjbart
New user
New user
Posts: 27
Joined: 2007-04-27 13:41

Post by timjbart » 2007-05-29 18:04

to use this script do I just past it at the end of my script file, then set scripts to ACTIVE?

Is that all there is to it? Also, how does this script work. How do I set the trigger points?

Post Reply