Post new topic Reply to topic  [ 6 posts ] 

Do you need this feature?
Yes 96%  96%  [ 23 ]
No 4%  4%  [ 1 ]
Total votes : 24
Author Message
 Post subject: mailbox size warning
PostPosted: 2005-05-31 15:58 
Normal user

Joined: 2004-06-14 17:20
Posts: 55
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..


Top
 Profile  
 
 Post subject:
PostPosted: 2005-06-02 20:45 
Senior user
Senior user

Joined: 2004-09-25 22:11
Posts: 550
Location: Atlanta, GA
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:

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 = "[email protected]"
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


Top
 Profile  
 
 Post subject:
PostPosted: 2006-02-18 00:09 
New user
New user

Joined: 2006-02-14 01:27
Posts: 26
Great script ! Thank you. There are very few features from commercial products still missing in hMailServer.

Your server is definitively an excellent work, martin !


Top
 Profile  
 
 Post subject:
PostPosted: 2006-02-18 00:09 
New user
New user

Joined: 2006-02-14 01:27
Posts: 26
Great script ! Thank you. There are very few features from commercial products still missing in hMailServer.

Your server is definitively an excellent work, martin !


Top
 Profile  
 
 Post subject:
PostPosted: 2006-02-18 17:21 
Moderator
User avatar

Joined: 2005-03-13 05:42
Posts: 1368
Location: Sydney Australia
Gee you are impressed lbs .. said it twice :-)

_________________
hMailServer 5.4 B1944 external MySQL 5.5
Win 2003 SP2 | IIS 6 | ClamAV 0.97.3 | PHP 5.3.17 | Roundcube Webmail 0.8.2


Top
 Profile  
 
 Post subject:
PostPosted: 2007-05-29 18:04 
New user
New user

Joined: 2007-04-27 13:41
Posts: 27
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?


Top
 Profile  
 
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 6 posts ] 


Who is online

Users browsing this forum: No registered users and 0 guests



Search for:
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group