hMailServer locks up Randomly

Use this forum if you have installed hMailServer and want to ask a question related to a production release of hMailServer. Before posting, please read the troubleshooting guide. A large part of all reported issues are already described in detail here.
User avatar
jimimaseye
Moderator
Moderator
Posts: 8968
Joined: 2011-09-08 17:48

Re: hMailServer locks up Randomly

Post by jimimaseye » 2015-04-13 19:49

Does the error happen ALL the time or randomly?

You could do a test.....

If you are able to get a completely idle system (ie no users online to be sending emails) and then send an email. What happens? is there an error as reported?

If you then log on to 2 different clients and try to simultaneously fire off 2 emails (one each) do you then get the error? (you might need to do a few tests to prove this).
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: 4438
Joined: 2006-08-21 15:38
Location: Denmark

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-13 20:14

jimimaseye wrote:Now, my post was based on the idea that if user1 sends an email at the same time as user 2, then there are 2x instances now fired off, each one dealing with each user, and yet both instances are trying to access the ONE .TXT file. And windows dont like that. So it would error.
Hmm... No file locking whatsoever... This means that every time the script fails it is loosing data. :roll:
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

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

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-13 21:18

Someone have a spare test server they don't use ??
This is totally UNTESTED... I'm not sure "Err.Number = 70" is the correct error code to wait for ...

Changes: ...

Functions Wait and OpenFile are new and copied from my own code library...

"Set f = fs.OpenTextFile(..." replaced by "Set f = OpenFile(..."

Code: Select all

'Force error on undeclared variables
Option Explicit

'------------------------------------------------------------------
' SMTP Limit - Global variables and settings
'------------------------------------------------------------------

'General
Public obApp
Public domain_buffer
Public Const ipslocalhost = "Blank for Privacy" 'separated by #
Public Const user = "Administrator"
Public Const pw = "Blank for Privacy" ' ## enter your hmail admin password here

Public Const write_log_active = False

'User and Domain outgoing limitation
Public Const outgoingstore = "c:\program files (x86)\hMailServer\Events\outboundstore.txt"
Public Const outgoingexceptions = "c:\program files (x86)\hMailServer\Events\outboundexceptions.txt"
Public Const outgoingstoreavg = "c:\program files (x86)\hMailServer\Events\outboundstoreavg.txt"
Public Const max_emails_per_user = 130
Public Const max_emails_per_domain = 75000
Public Const warning_factor = 0.8
Public Const server_average_days = 20 ' 0 will deactivate
Public Const server_average_threshold_factor = 10
Public Const warning_factor_avg = 0.6
Public Const msg_AdminName = """Blank for Privacy""" ' ## enter name here. N.B. leave """ as is.
Public Const msg_AdminEmail = "Blank for Privacy" ' ## enter your email admin email address here



Sub OnAcceptMessage(oClient, oMessage)
   Result.Value = 0
   Set obApp = CreateObject("hMailServer.Application")
   Call obApp.Authenticate(user, pw)

   If has_client_authenticated(oClient) Then
      write_log (" User has authenticated. User " & oCLient.username & ", Client " & oClient.IPAddress)
      if not check_outgoing_limitations(oClient, oMessage) Then
         Result.Message = "Your account/Mailserver has passed SMTP outgoing limits."
         Result.Value = 2
      End if
   End if
End Sub

'------------------------------------------------------------------
' SMTP Limit - Functions and Subs for outgoing emails of domain and user
'------------------------------------------------------------------

function check_outgoing_limitations(oClient, oMessage)
   check_outgoing_limitations = true
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs , f
   Set fs = CreateObject("scripting.filesystemobject")
   Dim idt
   Dim content
   Dim ln
   Dim arr
   Dim usern
   Dim usernadd
   Dim usernnr
   Dim usernnrmax
   Dim domn
   Dim domnadd
   Dim domnnr
   Dim domnnrmax
   Dim reason
   Dim rcptscnt
   Dim dayamounts(200)
   Dim i, k

   For i = 0 To 200
      dayamounts(i) = 0
   Next
   Dim pos
   Dim avg
   Dim minday
   minday = 999999
   Dim toindex
   Dim excptn

   write_log(" SMTP outgoing limitations")

   If oclient.username <> "" Then
      If instr(1,oclient.username,"@") = 0 Then
         usern = oclient.username & "@" & obApp.Settings.DefaultDomain
         domn = "@" & obApp.Settings.DefaultDomain
      Else
         usern = oclient.username
         domn = Mid(oclient.username,InStr(1,oclient.username,"@"))
      End If
   ElseIf is_local_domain(omessage.fromaddress) then
      usern = omessage.fromaddress
      domn = Mid(omessage.fromaddress,InStr(1,omessage.fromaddress,"@"))
   Else
      usern = "local"
      domn = "@local"
   End If
   content = "# SMTP outgoing storage" & nl & nl
   usernadd = true
   domnadd = true
   usernnr = 1
   domnnr = 1
   usernnrmax = max_emails_per_user
   domnnrmax = max_emails_per_domain
   idt = CLng(Date())
   rcptscnt = omessage.Recipients.count
   write_log(" Number of recipients " & rcptscnt)

   write_log(" Reading exceptions file " & outgoingexceptions)
   If fs.FileExists(outgoingexceptions) Then
'      Set f = fs.OpenTextFile(outgoingexceptions, ForReading)
      Set f = OpenFile(outgoingexceptions, ForReading)
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         If ln <> "" And Mid(ln,1,1) <> "#" And Len(ln) > 3 Then
            arr = Split(ln,Chr(9))
            If UBound(arr) = 1 Then
               If arr(0) = usern Then
                  usernnrmax = CLng(arr(1))
                  write_log (" new user limit " & ln)
               End if
               If arr(0) = domn Then
                  domnnrmax = CLng(arr(1))
                  write_log (" new domain limit " & ln)
               End if
            Else
               write_log (" cannot process line " & Mid(ln,1,25))
            End If
         ElseIf Len(ln) > 5 And f.Line > 4 + 1 then
            write_log (" skipping line " & Mid(ln,1,25))
         End If
      Loop
   Else
'      Set f = fs.OpenTextFile(outgoingexceptions, ForWriting, true)
      Set f = OpenFile(outgoingexceptions, ForWriting)
      f.Write("# Outgoing limitation exceptions tab / chr(9) separated" & nl)
      f.Write("# Examples (without # at the beginning)" & nl)
      f.Write("# @yourdomain.com 10000" & nl)
      f.Write("# address@yourdomain.com   5000" & nl & nl)
      f.Close
   End If

   write_log(" Reading storage file " & outgoingstore)
   If fs.FileExists(outgoingstore) Then
'      Set f = fs.OpenTextFile(outgoingstore, ForReading)
      Set f = OpenFile(outgoingstore, ForReading)
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         If ln <> "" And Mid(ln,1,1) <> "#" And Len(ln) > 5 Then
            arr = Split(ln," ")
            If UBound(arr) > 1 Then
               If minday > CLng(arr(0)) Then
                  minday = CLng(arr(0))
               End If
            End If
            If UBound(arr) = 2 Or UBound(arr) = 3 Then
               If CLng(arr(0)) = idt And arr(2) = usern Then
                  usernnr = CLng(arr(1)) + rcptscnt
                  usernadd = False
                  write_log (" adding to line " & ln)
                  If usernnr > usernnrmax Then
                     If UBound(arr) = 3 Then
                        If arr(3) = "X" then
                           write_log (" deny already sent")
                        Else
                           write_log (" sending deny")
                           outgoing_limitations_send_message oClient, oMessage, false, usernnr, usernnrmax, false
                        End if
                     Else
                        write_log (" sending deny")
                        outgoing_limitations_send_message oClient, oMessage, false, usernnr, usernnrmax, false
                     End If
                     content = content & arr(0) & " " & usernnr & " " & arr(2) & " X" & nl
                  ElseIf usernnr > usernnrmax * warning_factor then
                     If UBound(arr) = 3 Then
                        If arr(3) = "W" then
                           write_log (" warning already sent")
                        Else
                           write_log (" sending warning")
                           outgoing_limitations_send_message oClient, oMessage, true, usernnr, usernnrmax, false
                        End if
                     Else
                        write_log (" sending warning")
                        outgoing_limitations_send_message oClient, oMessage, true, usernnr, usernnrmax, false
                     End If
                     content = content & arr(0) & " " & usernnr & " " & arr(2) & " W" & nl
                  Else
                     content = content & arr(0) & " " & usernnr & " " & arr(2) & nl
                  End if
               elseIf CLng(arr(0)) = idt And arr(2) = domn Then
                  domnnr = CLng(arr(1)) + rcptscnt
                  domnadd = false
                  write_log (" adding to line " & ln)
                  If domnnr > domnnrmax Then
                     If UBound(arr) = 3 Then
                        If arr(3) = "X" then
                           write_log (" deny already sent")
                        Else
                           write_log (" sending deny")
                           outgoing_limitations_send_message oClient, oMessage, false, domnnr, domnnrmax, true
                        End if
                     Else
                        write_log (" sending deny")
                        outgoing_limitations_send_message oClient, oMessage, false, domnnr, domnnrmax, true
                     End If
                     content = content & arr(0) & " " & domnnr & " " & arr(2) & " X" & nl
                  ElseIf domnnr > domnnrmax * warning_factor then
                     If UBound(arr) = 3 Then
                        If arr(3) = "W" then
                           write_log (" warning already sent")
                        Else
                           write_log (" sending warning")
                           outgoing_limitations_send_message oClient, oMessage, true, domnnr, domnnrmax, true
                        End if
                     Else
                        write_log (" sending warning")
                        outgoing_limitations_send_message oClient, oMessage, true, domnnr, domnnrmax, true
                     End If
                     content = content & arr(0) & " " & domnnr & " " & arr(2) & " W" & nl
                  Else
                     content = content & arr(0) & " " & domnnr & " " & arr(2) & nl
                  End if
               ElseIf CLng(arr(0)) < idt - server_average_days Then
                  write_log (" deleting line " & ln)
               Else
                  content = content & arr(0) & " " & arr(1) & " " & arr(2) & nl
'write_log (" copying line " & ln)
               End If
               If Mid(arr(2),1,1) <> "@" Then
                  pos = idt - CLng(arr(0))
                  dayamounts(pos) = dayamounts(pos) + CLng(arr(1))
               End If
            Else
               write_log (" cannot process line " & Mid(ln,1,25))
            End If
         ElseIf Len(ln) > 5 And f.Line > 1 + 1 then
            write_log (" skipping line " & Mid(ln,1,25))
         End If
      Loop
      f.Close
      If usernadd Then
         content = content & idt & " " & usernnr & " " & usern & nl
      End If
      If domnadd Then
         content = content & idt & " " & domnnr & " " & domn & nl
      End If
'      Set f = fs.OpenTextFile(outgoingstore, ForWriting, true)
      Set f = OpenFile(outgoingstore, ForWriting)
      f.Write(content)
      f.Close
   Else
      content = content & idt & " " & usernnr & " " & usern & nl
      content = content & idt & " " & domnnr & " " & domn & nl
'      Set f = fs.OpenTextFile(outgoingstore, ForWriting, true)
      Set f = OpenFile(outgoingstore, ForWriting)
      f.Write(content)
      f.Close
   End If

   toindex = idt - minday
   avg = CDbl(0)
   If toindex >=5 then
      For i = 1 To toindex
         avg = avg + CDbl(dayamounts(i))
      Next
      avg = CDbl(avg) / CDbl(toindex)
      write_log(" Statistic calculation over " & server_average_days & " days")
      write_log(" todays amount " & dayamounts(0) & " average " & avg & " maximum " & avg * server_average_threshold_factor)
      write_log(" Checking statistics")
   End If
   If toindex < 5 then
      write_log(" Statistic calculation is only done over at least 5 days. Available days: " & toindex)
   ElseIf avg < 5 Then
      write_log(" average below 5 mails per day, ignoring average statistic")
   ElseIf dayamounts(0) > avg * server_average_threshold_factor Then
      write_log(" todays amount has passed limit of " & avg * server_average_threshold_factor)
      outgoing_limitations_avg_send_admin dayamounts(0),avg * server_average_threshold_factor,false
      check_outgoing_limitations = False
   ElseIf dayamounts(0) > avg * server_average_threshold_factor * warning_factor_avg Then
      write_log(" todays amount has passed warning level of " & avg * server_average_threshold_factor * warning_factor_avg)
      outgoing_limitations_avg_send_admin dayamounts(0),avg * server_average_threshold_factor,true
      check_outgoing_limitations = False
   Else
      write_log(" within limits")
   End If

   write_log(" Checking limits")
   If usernnrmax < usernnr Then
      check_outgoing_limitations = false
      write_log(" max of user passed!")
   ElseIf domnnrmax < domnnr Then
      check_outgoing_limitations = false
      write_log(" max of domain passed!")
   Else
      write_log(" within limits")
   End If

   excptn = false
   If oMessage.FromAddress = msg_AdminEmail Then
      excptn = true
   Else
      For k = 0 To oMessage.recipients.count - 1
         If oMessage.recipients(k).OriginalAddress = msg_AdminEmail Then
            excptn = True
         End If
      Next
   End If
   If excptn = True Then
      write_log(" Mail from/to admin -> passes lock")
      check_outgoing_limitations = true
   End if
End function

Sub outgoing_limitations_avg_send_admin(nr, max, iswarning)
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs , f
   Set fs = CreateObject("scripting.filesystemobject")
   Dim txt
   Dim tmp
   Dim nMessage
   Dim str
   Dim out
   Dim snd

   If iswarning Then
      tmp = "Warning: Todays outgoing emails will reach lock soon"

      txt = "Hello " & msg_AdminEmail & nl & nl
      txt = txt & "todays outgoing email will reach avg limit soon." & nl & nl
      txt = txt & "Current amount is " & nr & nl
      txt = txt & "Limit is " & max & nl & nl
      txt = txt & "Regards" & nl
      txt = txt & msg_AdminEmail

      str = "W" & CLng(Date())
   Else
      tmp = "Locked: Todays outgoing emails have passed avg limit"

      txt = "Hello " & msg_AdminEmail & nl & nl
      txt = txt & "todays outgoing email have passed avg limit." & nl & nl
      txt = txt & "Current amount is " & nr & nl
      txt = txt & "Limit is " & max & nl & nl
      txt = txt & "Regards" & nl
      txt = txt & msg_AdminEmail

      str = "X" & CLng(Date())
   End If

   snd = true
   If fs.FileExists(outgoingstoreavg) Then
'      Set f = fs.OpenTextFile(outgoingstoreavg,ForReading)
      Set f = OpenFile(outgoingstoreavg,ForReading)
      out = f.ReadAll
      f.Close
      If out = str Then
         snd = false
      End If
   End If

   If snd then
      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient msg_AdminName, msg_AdminEmail
      nMessage.Subject = tmp
      nMessage.Body = txt
      nMessage.Save

'      Set f = fs.OpenTextFile(outgoingstoreavg,ForWriting,True)
      Set f = OpenFile(outgoingstoreavg,ForWriting)
      f.Write(str)
      f.Close
   End If
End Sub

Sub outgoing_limitations_send_message(oClient, oMessage, iswarning, nr, max, isdomain)
   Dim txt
   Dim tmp
   Dim nMessage
   Dim strAccount
   Dim strFromName
   Dim strFromAddress

   tmp = oMessage.From

   if (InStr(1, oMessage.From, "<", 1) > 0) Then
      strAccount = split(oMessage.From, "<")
      strFromAddress = Replace(strAccount(1), ">", "")
      strFromName = Trim(strAccount(0))
      strFromName = Replace (strFromName, """", "")
   Else
      strFromAddress = oMessage.From
      strAccount = split(oMessage.From, "@")
      strFromName = strAccount(0)
   End If

   If iswarning Then
      txt = "Hello " & tmp & nl & nl
      txt = txt & "You are approaching the limit of sent mail allowed for today." & nl & nl
      txt = txt & "Current messages sent: " & nr & nl
      txt = txt & "Daily limit: " & max & nl & nl
      If isdomain Then
         txt = txt & "This is a limit of your domain." & nl & nl
      Else
         txt = txt & "For more information please visit: Blanked for Privacy" & nl & nl
      End If
      txt = txt & "Regards" & nl
      txt = txt & msg_AdminEmail

      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient strFromName, strFromAddress
      nMessage.Subject = "Warning: Account limits will be reached soon"
      nMessage.Body = txt
      nMessage.Save
   Else
      txt = "Hello " & tmp & nl & nl
      txt = txt & "You have exceeded the allowed sent messages for today. As a result your account is now locked from sending email." & nl & nl
      txt = txt & "Total messages sent: " & nr & nl
      txt = txt & "Daily limit: " & max & nl & nl
      If isdomain Then
         txt = txt & "This is a limit of the your domain." & nl & nl
      Else
         txt = txt & "If you did not personally send 100+ messages today it is very likely that either your computer or email account has been compromised." & nl & nl
      End If
      txt = txt & "Please contact us ASAP to get this situation rectified," & nl & nl
      txt = txt & "Blanked for Privacy" & nl & nl
      txt = txt & msg_AdminEmail

      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient msg_AdminName, msg_AdminEmail
      nMessage.Subject = "Account Locked: Account limits passed"
      nMessage.Body = txt
      nMessage.Save

      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient strFromName, strFromAddress
      nMessage.Subject = "Locked: Account limits passed"
      nMessage.Body = txt
      nMessage.Save
   End If
End Sub

'------------------------------------------------------------------
' General functions of all scripts
'------------------------------------------------------------------

Sub write_log(txt)
   If write_log_active then
      EventLog.Write("Limit SMTP Script:"+txt)
   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

Function is_local_domain(domain_or_email)
   is_local_domain = False
   Dim domain
   Dim doms
   Dim alss
   Dim i
   Dim j

   If InStr(1," " & domain_or_email,"@") > 0 Then
      domain = Mid(domain_or_email, InStr(1,domain_or_email,"@") + 1)
   Else
      domain = domain_or_email
   End If

   If domain_buffer = "" then
      i = 0
      Set doms = obapp.Domains
      Do While i <= doms.Count - 1
         Set dom = doms.Item(i)
         domain_buffer = domain_buffer & "#" & dom.Name
         j = 0
         Set alss = dom.DomainAliases
         Do While j <= alss.Count - 1
            Set als = alss.item(j)
            domain_buffer = domain_buffer & "#" & als.AliasName
            j = j + 1
         Loop
         i = i + 1
      Loop
   End If

   If InStr(1, " " & domain_buffer, domain) > 0 Then
      is_local_domain = True
   End If
End Function

Function has_client_authenticated(oclient)
   has_client_authenticated = false
   If oCLient.username <> "" Or InStr(1," " & ipslocalhost, oClient.IPAddress) > 0 Then
      has_client_authenticated = true
   End if
End Function

Function Wait(sec)
   Dim t
   t = Timer
   Do While ((Timer - t) < sec) Xor (Timer < t)
   Loop
End Function

Function OpenFile(strPath, ioMode)
   With CreateObject("Scripting.FileSystemObject")
      Dim oFile, i
      For i = 0 To 30
         On Error Resume Next
         Set oFile = .OpenTextFile(strPath, ioMode, True)
         If (Not Err.Number = 70) Then
            Set OpenFile = oFile
            On Error Goto 0
            Exit For
         End If
         On Error Goto 0
         Wait(1)
      Next
   End With
   Set oFile = Nothing
   If (Err.Number = 70) Then
      EventLog.Write("ERROR: VBScript Function OpenFile")
      EventLog.Write("File " & strPath & " is locked and timeout was exceeded.")
      Err.Clear
   ElseIf (Err.Number <> 0) Then
      EventLog.Write("ERROR: VBScript Function OpenFile")
      EventLog.Write("Error       : " & Err.Number)
      EventLog.Write("Error (hex) : 0x" & Hex(Err.Number))
      EventLog.Write("Source      : " & Err.Source)
      EventLog.Write("Description : " & Err.Description)
      Err.Clear
   End If
End Function
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

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

Re: hMailServer locks up Randomly

Post by jimimaseye » 2015-04-13 22:03

So you think I am on to something there with my file locking theory, Soren?

Im guessing that the script you have given cant be that damaging if it is based on the original and all that is wrong is your severity code. If was installed and , whats the worse thing that could happen - it crashes?? :roll:
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: 4438
Joined: 2006-08-21 15:38
Location: Denmark

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-13 22:19

jimimaseye wrote:So you think I am on to something there with my file locking theory, Soren?

Im guessing that the script you have given cant be that damaging if it is based on the original and all that is wrong is your severity code. If was installed and , whats the worse thing that could happen - it crashes?? :roll:
Yeah, something like that... Unfortunately I don't have a free (enough) system at the moment :roll:

My OpenFile function is basicly a Retry layer wrapped around the CreateObject("Scripting.FileSystemObject")..

Also, to save code lines I reuse the same "Set oFile = .OpenTextFile(strPath, ioMode, True)" for both Reading and Writing and I'm not sure the "True" parameter is going to be a problem on "ForReading"... Otherwise I guess Microsoft would have mentioned on TechNet.. or something..
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

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

Re: hMailServer locks up Randomly

Post by jimimaseye » 2015-04-13 22:37

SorenR wrote: I reuse the same "Set oFile = .OpenTextFile(strPath, ioMode, True)" for both Reading and Writing and I'm not sure the "True" parameter is going to be a problem on "ForReading"...
Thought about or tried adopting 'OpenAsTextStream' instead? It seems to have less ambiguity (one command, allows both read AND write): https://msdn.microsoft.com/en-us/librar ... 84%29.aspx

(Im no expert though, you're the guru. Just interpreting what I read.)
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

EcHoOfInSaNiTy
Normal user
Normal user
Posts: 42
Joined: 2015-03-13 02:12

Re: hMailServer locks up Randomly

Post by EcHoOfInSaNiTy » 2015-04-18 01:44

SorenR wrote:Someone have a spare test server they don't use ??
This is totally UNTESTED... I'm not sure "Err.Number = 70" is the correct error code to wait for ...

Changes: ...

Functions Wait and OpenFile are new and copied from my own code library...

"Set f = fs.OpenTextFile(..." replaced by "Set f = OpenFile(..."

Code: Select all

'Force error on undeclared variables
Option Explicit

'------------------------------------------------------------------
' SMTP Limit - Global variables and settings
'------------------------------------------------------------------

'General
Public obApp
Public domain_buffer
Public Const ipslocalhost = "Blank for Privacy" 'separated by #
Public Const user = "Administrator"
Public Const pw = "Blank for Privacy" ' ## enter your hmail admin password here

Public Const write_log_active = False

'User and Domain outgoing limitation
Public Const outgoingstore = "c:\program files (x86)\hMailServer\Events\outboundstore.txt"
Public Const outgoingexceptions = "c:\program files (x86)\hMailServer\Events\outboundexceptions.txt"
Public Const outgoingstoreavg = "c:\program files (x86)\hMailServer\Events\outboundstoreavg.txt"
Public Const max_emails_per_user = 130
Public Const max_emails_per_domain = 75000
Public Const warning_factor = 0.8
Public Const server_average_days = 20 ' 0 will deactivate
Public Const server_average_threshold_factor = 10
Public Const warning_factor_avg = 0.6
Public Const msg_AdminName = """Blank for Privacy""" ' ## enter name here. N.B. leave """ as is.
Public Const msg_AdminEmail = "Blank for Privacy" ' ## enter your email admin email address here



Sub OnAcceptMessage(oClient, oMessage)
   Result.Value = 0
   Set obApp = CreateObject("hMailServer.Application")
   Call obApp.Authenticate(user, pw)

   If has_client_authenticated(oClient) Then
      write_log (" User has authenticated. User " & oCLient.username & ", Client " & oClient.IPAddress)
      if not check_outgoing_limitations(oClient, oMessage) Then
         Result.Message = "Your account/Mailserver has passed SMTP outgoing limits."
         Result.Value = 2
      End if
   End if
End Sub

'------------------------------------------------------------------
' SMTP Limit - Functions and Subs for outgoing emails of domain and user
'------------------------------------------------------------------

function check_outgoing_limitations(oClient, oMessage)
   check_outgoing_limitations = true
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs , f
   Set fs = CreateObject("scripting.filesystemobject")
   Dim idt
   Dim content
   Dim ln
   Dim arr
   Dim usern
   Dim usernadd
   Dim usernnr
   Dim usernnrmax
   Dim domn
   Dim domnadd
   Dim domnnr
   Dim domnnrmax
   Dim reason
   Dim rcptscnt
   Dim dayamounts(200)
   Dim i, k

   For i = 0 To 200
      dayamounts(i) = 0
   Next
   Dim pos
   Dim avg
   Dim minday
   minday = 999999
   Dim toindex
   Dim excptn

   write_log(" SMTP outgoing limitations")

   If oclient.username <> "" Then
      If instr(1,oclient.username,"@") = 0 Then
         usern = oclient.username & "@" & obApp.Settings.DefaultDomain
         domn = "@" & obApp.Settings.DefaultDomain
      Else
         usern = oclient.username
         domn = Mid(oclient.username,InStr(1,oclient.username,"@"))
      End If
   ElseIf is_local_domain(omessage.fromaddress) then
      usern = omessage.fromaddress
      domn = Mid(omessage.fromaddress,InStr(1,omessage.fromaddress,"@"))
   Else
      usern = "local"
      domn = "@local"
   End If
   content = "# SMTP outgoing storage" & nl & nl
   usernadd = true
   domnadd = true
   usernnr = 1
   domnnr = 1
   usernnrmax = max_emails_per_user
   domnnrmax = max_emails_per_domain
   idt = CLng(Date())
   rcptscnt = omessage.Recipients.count
   write_log(" Number of recipients " & rcptscnt)

   write_log(" Reading exceptions file " & outgoingexceptions)
   If fs.FileExists(outgoingexceptions) Then
'      Set f = fs.OpenTextFile(outgoingexceptions, ForReading)
      Set f = OpenFile(outgoingexceptions, ForReading)
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         If ln <> "" And Mid(ln,1,1) <> "#" And Len(ln) > 3 Then
            arr = Split(ln,Chr(9))
            If UBound(arr) = 1 Then
               If arr(0) = usern Then
                  usernnrmax = CLng(arr(1))
                  write_log (" new user limit " & ln)
               End if
               If arr(0) = domn Then
                  domnnrmax = CLng(arr(1))
                  write_log (" new domain limit " & ln)
               End if
            Else
               write_log (" cannot process line " & Mid(ln,1,25))
            End If
         ElseIf Len(ln) > 5 And f.Line > 4 + 1 then
            write_log (" skipping line " & Mid(ln,1,25))
         End If
      Loop
   Else
'      Set f = fs.OpenTextFile(outgoingexceptions, ForWriting, true)
      Set f = OpenFile(outgoingexceptions, ForWriting)
      f.Write("# Outgoing limitation exceptions tab / chr(9) separated" & nl)
      f.Write("# Examples (without # at the beginning)" & nl)
      f.Write("# @yourdomain.com 10000" & nl)
      f.Write("# address@yourdomain.com   5000" & nl & nl)
      f.Close
   End If

   write_log(" Reading storage file " & outgoingstore)
   If fs.FileExists(outgoingstore) Then
'      Set f = fs.OpenTextFile(outgoingstore, ForReading)
      Set f = OpenFile(outgoingstore, ForReading)
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         If ln <> "" And Mid(ln,1,1) <> "#" And Len(ln) > 5 Then
            arr = Split(ln," ")
            If UBound(arr) > 1 Then
               If minday > CLng(arr(0)) Then
                  minday = CLng(arr(0))
               End If
            End If
            If UBound(arr) = 2 Or UBound(arr) = 3 Then
               If CLng(arr(0)) = idt And arr(2) = usern Then
                  usernnr = CLng(arr(1)) + rcptscnt
                  usernadd = False
                  write_log (" adding to line " & ln)
                  If usernnr > usernnrmax Then
                     If UBound(arr) = 3 Then
                        If arr(3) = "X" then
                           write_log (" deny already sent")
                        Else
                           write_log (" sending deny")
                           outgoing_limitations_send_message oClient, oMessage, false, usernnr, usernnrmax, false
                        End if
                     Else
                        write_log (" sending deny")
                        outgoing_limitations_send_message oClient, oMessage, false, usernnr, usernnrmax, false
                     End If
                     content = content & arr(0) & " " & usernnr & " " & arr(2) & " X" & nl
                  ElseIf usernnr > usernnrmax * warning_factor then
                     If UBound(arr) = 3 Then
                        If arr(3) = "W" then
                           write_log (" warning already sent")
                        Else
                           write_log (" sending warning")
                           outgoing_limitations_send_message oClient, oMessage, true, usernnr, usernnrmax, false
                        End if
                     Else
                        write_log (" sending warning")
                        outgoing_limitations_send_message oClient, oMessage, true, usernnr, usernnrmax, false
                     End If
                     content = content & arr(0) & " " & usernnr & " " & arr(2) & " W" & nl
                  Else
                     content = content & arr(0) & " " & usernnr & " " & arr(2) & nl
                  End if
               elseIf CLng(arr(0)) = idt And arr(2) = domn Then
                  domnnr = CLng(arr(1)) + rcptscnt
                  domnadd = false
                  write_log (" adding to line " & ln)
                  If domnnr > domnnrmax Then
                     If UBound(arr) = 3 Then
                        If arr(3) = "X" then
                           write_log (" deny already sent")
                        Else
                           write_log (" sending deny")
                           outgoing_limitations_send_message oClient, oMessage, false, domnnr, domnnrmax, true
                        End if
                     Else
                        write_log (" sending deny")
                        outgoing_limitations_send_message oClient, oMessage, false, domnnr, domnnrmax, true
                     End If
                     content = content & arr(0) & " " & domnnr & " " & arr(2) & " X" & nl
                  ElseIf domnnr > domnnrmax * warning_factor then
                     If UBound(arr) = 3 Then
                        If arr(3) = "W" then
                           write_log (" warning already sent")
                        Else
                           write_log (" sending warning")
                           outgoing_limitations_send_message oClient, oMessage, true, domnnr, domnnrmax, true
                        End if
                     Else
                        write_log (" sending warning")
                        outgoing_limitations_send_message oClient, oMessage, true, domnnr, domnnrmax, true
                     End If
                     content = content & arr(0) & " " & domnnr & " " & arr(2) & " W" & nl
                  Else
                     content = content & arr(0) & " " & domnnr & " " & arr(2) & nl
                  End if
               ElseIf CLng(arr(0)) < idt - server_average_days Then
                  write_log (" deleting line " & ln)
               Else
                  content = content & arr(0) & " " & arr(1) & " " & arr(2) & nl
'write_log (" copying line " & ln)
               End If
               If Mid(arr(2),1,1) <> "@" Then
                  pos = idt - CLng(arr(0))
                  dayamounts(pos) = dayamounts(pos) + CLng(arr(1))
               End If
            Else
               write_log (" cannot process line " & Mid(ln,1,25))
            End If
         ElseIf Len(ln) > 5 And f.Line > 1 + 1 then
            write_log (" skipping line " & Mid(ln,1,25))
         End If
      Loop
      f.Close
      If usernadd Then
         content = content & idt & " " & usernnr & " " & usern & nl
      End If
      If domnadd Then
         content = content & idt & " " & domnnr & " " & domn & nl
      End If
'      Set f = fs.OpenTextFile(outgoingstore, ForWriting, true)
      Set f = OpenFile(outgoingstore, ForWriting)
      f.Write(content)
      f.Close
   Else
      content = content & idt & " " & usernnr & " " & usern & nl
      content = content & idt & " " & domnnr & " " & domn & nl
'      Set f = fs.OpenTextFile(outgoingstore, ForWriting, true)
      Set f = OpenFile(outgoingstore, ForWriting)
      f.Write(content)
      f.Close
   End If

   toindex = idt - minday
   avg = CDbl(0)
   If toindex >=5 then
      For i = 1 To toindex
         avg = avg + CDbl(dayamounts(i))
      Next
      avg = CDbl(avg) / CDbl(toindex)
      write_log(" Statistic calculation over " & server_average_days & " days")
      write_log(" todays amount " & dayamounts(0) & " average " & avg & " maximum " & avg * server_average_threshold_factor)
      write_log(" Checking statistics")
   End If
   If toindex < 5 then
      write_log(" Statistic calculation is only done over at least 5 days. Available days: " & toindex)
   ElseIf avg < 5 Then
      write_log(" average below 5 mails per day, ignoring average statistic")
   ElseIf dayamounts(0) > avg * server_average_threshold_factor Then
      write_log(" todays amount has passed limit of " & avg * server_average_threshold_factor)
      outgoing_limitations_avg_send_admin dayamounts(0),avg * server_average_threshold_factor,false
      check_outgoing_limitations = False
   ElseIf dayamounts(0) > avg * server_average_threshold_factor * warning_factor_avg Then
      write_log(" todays amount has passed warning level of " & avg * server_average_threshold_factor * warning_factor_avg)
      outgoing_limitations_avg_send_admin dayamounts(0),avg * server_average_threshold_factor,true
      check_outgoing_limitations = False
   Else
      write_log(" within limits")
   End If

   write_log(" Checking limits")
   If usernnrmax < usernnr Then
      check_outgoing_limitations = false
      write_log(" max of user passed!")
   ElseIf domnnrmax < domnnr Then
      check_outgoing_limitations = false
      write_log(" max of domain passed!")
   Else
      write_log(" within limits")
   End If

   excptn = false
   If oMessage.FromAddress = msg_AdminEmail Then
      excptn = true
   Else
      For k = 0 To oMessage.recipients.count - 1
         If oMessage.recipients(k).OriginalAddress = msg_AdminEmail Then
            excptn = True
         End If
      Next
   End If
   If excptn = True Then
      write_log(" Mail from/to admin -> passes lock")
      check_outgoing_limitations = true
   End if
End function

Sub outgoing_limitations_avg_send_admin(nr, max, iswarning)
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs , f
   Set fs = CreateObject("scripting.filesystemobject")
   Dim txt
   Dim tmp
   Dim nMessage
   Dim str
   Dim out
   Dim snd

   If iswarning Then
      tmp = "Warning: Todays outgoing emails will reach lock soon"

      txt = "Hello " & msg_AdminEmail & nl & nl
      txt = txt & "todays outgoing email will reach avg limit soon." & nl & nl
      txt = txt & "Current amount is " & nr & nl
      txt = txt & "Limit is " & max & nl & nl
      txt = txt & "Regards" & nl
      txt = txt & msg_AdminEmail

      str = "W" & CLng(Date())
   Else
      tmp = "Locked: Todays outgoing emails have passed avg limit"

      txt = "Hello " & msg_AdminEmail & nl & nl
      txt = txt & "todays outgoing email have passed avg limit." & nl & nl
      txt = txt & "Current amount is " & nr & nl
      txt = txt & "Limit is " & max & nl & nl
      txt = txt & "Regards" & nl
      txt = txt & msg_AdminEmail

      str = "X" & CLng(Date())
   End If

   snd = true
   If fs.FileExists(outgoingstoreavg) Then
'      Set f = fs.OpenTextFile(outgoingstoreavg,ForReading)
      Set f = OpenFile(outgoingstoreavg,ForReading)
      out = f.ReadAll
      f.Close
      If out = str Then
         snd = false
      End If
   End If

   If snd then
      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient msg_AdminName, msg_AdminEmail
      nMessage.Subject = tmp
      nMessage.Body = txt
      nMessage.Save

'      Set f = fs.OpenTextFile(outgoingstoreavg,ForWriting,True)
      Set f = OpenFile(outgoingstoreavg,ForWriting)
      f.Write(str)
      f.Close
   End If
End Sub

Sub outgoing_limitations_send_message(oClient, oMessage, iswarning, nr, max, isdomain)
   Dim txt
   Dim tmp
   Dim nMessage
   Dim strAccount
   Dim strFromName
   Dim strFromAddress

   tmp = oMessage.From

   if (InStr(1, oMessage.From, "<", 1) > 0) Then
      strAccount = split(oMessage.From, "<")
      strFromAddress = Replace(strAccount(1), ">", "")
      strFromName = Trim(strAccount(0))
      strFromName = Replace (strFromName, """", "")
   Else
      strFromAddress = oMessage.From
      strAccount = split(oMessage.From, "@")
      strFromName = strAccount(0)
   End If

   If iswarning Then
      txt = "Hello " & tmp & nl & nl
      txt = txt & "You are approaching the limit of sent mail allowed for today." & nl & nl
      txt = txt & "Current messages sent: " & nr & nl
      txt = txt & "Daily limit: " & max & nl & nl
      If isdomain Then
         txt = txt & "This is a limit of your domain." & nl & nl
      Else
         txt = txt & "For more information please visit: Blanked for Privacy" & nl & nl
      End If
      txt = txt & "Regards" & nl
      txt = txt & msg_AdminEmail

      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient strFromName, strFromAddress
      nMessage.Subject = "Warning: Account limits will be reached soon"
      nMessage.Body = txt
      nMessage.Save
   Else
      txt = "Hello " & tmp & nl & nl
      txt = txt & "You have exceeded the allowed sent messages for today. As a result your account is now locked from sending email." & nl & nl
      txt = txt & "Total messages sent: " & nr & nl
      txt = txt & "Daily limit: " & max & nl & nl
      If isdomain Then
         txt = txt & "This is a limit of the your domain." & nl & nl
      Else
         txt = txt & "If you did not personally send 100+ messages today it is very likely that either your computer or email account has been compromised." & nl & nl
      End If
      txt = txt & "Please contact us ASAP to get this situation rectified," & nl & nl
      txt = txt & "Blanked for Privacy" & nl & nl
      txt = txt & msg_AdminEmail

      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient msg_AdminName, msg_AdminEmail
      nMessage.Subject = "Account Locked: Account limits passed"
      nMessage.Body = txt
      nMessage.Save

      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient strFromName, strFromAddress
      nMessage.Subject = "Locked: Account limits passed"
      nMessage.Body = txt
      nMessage.Save
   End If
End Sub

'------------------------------------------------------------------
' General functions of all scripts
'------------------------------------------------------------------

Sub write_log(txt)
   If write_log_active then
      EventLog.Write("Limit SMTP Script:"+txt)
   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

Function is_local_domain(domain_or_email)
   is_local_domain = False
   Dim domain
   Dim doms
   Dim alss
   Dim i
   Dim j

   If InStr(1," " & domain_or_email,"@") > 0 Then
      domain = Mid(domain_or_email, InStr(1,domain_or_email,"@") + 1)
   Else
      domain = domain_or_email
   End If

   If domain_buffer = "" then
      i = 0
      Set doms = obapp.Domains
      Do While i <= doms.Count - 1
         Set dom = doms.Item(i)
         domain_buffer = domain_buffer & "#" & dom.Name
         j = 0
         Set alss = dom.DomainAliases
         Do While j <= alss.Count - 1
            Set als = alss.item(j)
            domain_buffer = domain_buffer & "#" & als.AliasName
            j = j + 1
         Loop
         i = i + 1
      Loop
   End If

   If InStr(1, " " & domain_buffer, domain) > 0 Then
      is_local_domain = True
   End If
End Function

Function has_client_authenticated(oclient)
   has_client_authenticated = false
   If oCLient.username <> "" Or InStr(1," " & ipslocalhost, oClient.IPAddress) > 0 Then
      has_client_authenticated = true
   End if
End Function

Function Wait(sec)
   Dim t
   t = Timer
   Do While ((Timer - t) < sec) Xor (Timer < t)
   Loop
End Function

Function OpenFile(strPath, ioMode)
   With CreateObject("Scripting.FileSystemObject")
      Dim oFile, i
      For i = 0 To 30
         On Error Resume Next
         Set oFile = .OpenTextFile(strPath, ioMode, True)
         If (Not Err.Number = 70) Then
            Set OpenFile = oFile
            On Error Goto 0
            Exit For
         End If
         On Error Goto 0
         Wait(1)
      Next
   End With
   Set oFile = Nothing
   If (Err.Number = 70) Then
      EventLog.Write("ERROR: VBScript Function OpenFile")
      EventLog.Write("File " & strPath & " is locked and timeout was exceeded.")
      Err.Clear
   ElseIf (Err.Number <> 0) Then
      EventLog.Write("ERROR: VBScript Function OpenFile")
      EventLog.Write("Error       : " & Err.Number)
      EventLog.Write("Error (hex) : 0x" & Hex(Err.Number))
      EventLog.Write("Source      : " & Err.Source)
      EventLog.Write("Description : " & Err.Description)
      Err.Clear
   End If
End Function
So essentially your saying replace all instances of Set f = fs.OpenTextFile with Set f = OpenFile ?

Still looks to be the only error spamming my logs:

"ERROR" 6388 "2015-04-17 06:47:31.993" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 6388 "2015-04-17 08:40:03.143" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 6388 "2015-04-17 08:59:00.741" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 11788 "2015-04-17 09:20:56.553" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 16720 "2015-04-17 09:26:26.755" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 16720 "2015-04-17 09:27:01.726" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 11788 "2015-04-17 09:35:24.465" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 11788 "2015-04-17 10:14:54.559" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 11788 "2015-04-17 10:27:44.872" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 18560 "2015-04-17 11:06:21.974" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 16720 "2015-04-17 12:46:46.221" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 3404 "2015-04-17 12:56:39.360" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 6388 "2015-04-17 13:19:46.812" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 11788 "2015-04-17 14:33:31.069" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 11788 "2015-04-17 14:45:24.190" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"
"ERROR" 11788 "2015-04-17 14:48:25.683" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A0046 - Description: Permission denied - Line: 245 Column: 2 - Code: (null)"

EcHoOfInSaNiTy
Normal user
Normal user
Posts: 42
Joined: 2015-03-13 02:12

Re: hMailServer locks up Randomly

Post by EcHoOfInSaNiTy » 2015-04-18 01:54

I see in the script here:

Set f = fs.OpenTextFile(outgoingexceptions, ForReading)
Set f = OpenFile(outgoingexceptions, ForReading)

Am I adding that line? or replacing Set f = fs.OpenTextFile(outgoingexceptions, ForReading) with Set f = OpenFile(outgoingexceptions, ForReading)

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

Re: hMailServer locks up Randomly

Post by mattg » 2015-04-18 05:42

EcHoOfInSaNiTy wrote:I see in the script here:

Set f = fs.OpenTextFile(outgoingexceptions, ForReading)
Set f = OpenFile(outgoingexceptions, ForReading)

Am I adding that line? or replacing Set f = fs.OpenTextFile(outgoingexceptions, ForReading) with Set f = OpenFile(outgoingexceptions, ForReading)
Without looking at the code...

I'd say replace
(Keep a copy of your script as backup in case)
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
jimimaseye
Moderator
Moderator
Posts: 8968
Joined: 2011-09-08 17:48

Re: hMailServer locks up Randomly

Post by jimimaseye » 2015-04-18 09:30

EcHoOfInSaNiTy wrote:I see in the script here:

Set f = fs.OpenTextFile(outgoingexceptions, ForReading)
Set f = OpenFile(outgoingexceptions, ForReading)

Am I adding that line? or replacing Set f = fs.OpenTextFile(outgoingexceptions, ForReading) with Set f = OpenFile(outgoingexceptions, ForReading)
Why aren't you just replacing the script with the new one provided? If you were then such questions wouldn't be relevant and the chances of missing modifications and corrected functionality wouldn't be there.
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: 4438
Joined: 2006-08-21 15:38
Location: Denmark

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-18 11:12

jimimaseye wrote:
EcHoOfInSaNiTy wrote:I see in the script here:

Set f = fs.OpenTextFile(outgoingexceptions, ForReading)
Set f = OpenFile(outgoingexceptions, ForReading)

Am I adding that line? or replacing Set f = fs.OpenTextFile(outgoingexceptions, ForReading) with Set f = OpenFile(outgoingexceptions, ForReading)
Why aren't you just replacing the script with the new one provided? If you were then such questions wouldn't be relevant and the chances of missing modifications and corrected functionality wouldn't be there.
It would make it easier to decode line 245 :mrgreen:

Code: Select all

This:      Set f = OpenFile(outgoingstore, ForWriting)
Or this:      f.Write(content)
?
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

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

Re: hMailServer locks up Randomly

Post by jimimaseye » 2015-04-18 14:32

But your script uses additional 'functions' and he needs to ensure they are included too. I would do a total replace to ensure consistency.
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

EcHoOfInSaNiTy
Normal user
Normal user
Posts: 42
Joined: 2015-03-13 02:12

Re: hMailServer locks up Randomly

Post by EcHoOfInSaNiTy » 2015-04-18 15:59

jimimaseye wrote:But your script uses additional 'functions' and he needs to ensure they are included too. I would do a total replace to ensure consistency.
So is the general consensus that I keep both lines and just copy and paste the entire modified script soren provided?

EcHoOfInSaNiTy
Normal user
Normal user
Posts: 42
Joined: 2015-03-13 02:12

Re: hMailServer locks up Randomly

Post by EcHoOfInSaNiTy » 2015-04-18 16:01

EcHoOfInSaNiTy wrote:
jimimaseye wrote:But your script uses additional 'functions' and he needs to ensure they are included too. I would do a total replace to ensure consistency.
So is the general consensus that I keep both lines and just copy and paste the entire modified script soren provided?
Soren what's your suggestion?

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

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-18 20:50

EcHoOfInSaNiTy wrote:
EcHoOfInSaNiTy wrote:
jimimaseye wrote:But your script uses additional 'functions' and he needs to ensure they are included too. I would do a total replace to ensure consistency.
So is the general consensus that I keep both lines and just copy and paste the entire modified script soren provided?
Soren what's your suggestion?
Well.... Rename your old script and use the one above, you will need to edit it to adjust your settings...

The reason I left the old lines in there as comments (line beginning with a ' ) was to show the difference. You can remove them or leave them in... I'd leave them in for now so it matches the one I have... That way I'll know what "line 245" is :wink:
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

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

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-20 15:56

Finally got the time to test the script... It appears to work as intended :mrgreen:

Note to self: remember to reload script in hMailServer GUI AFTER making changes :roll: Just spent 10 minutes chasing an error that was not there...
Image

I had to merge the script into my existing eventhandlers.vbs which is now over 1.100 lines :roll:
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

EcHoOfInSaNiTy
Normal user
Normal user
Posts: 42
Joined: 2015-03-13 02:12

Re: hMailServer locks up Randomly

Post by EcHoOfInSaNiTy » 2015-04-20 16:17

SorenR wrote:Finally got the time to test the script... It appears to work as intended :mrgreen:

Note to self: remember to reload script in hMailServer GUI AFTER making changes :roll: Just spent 10 minutes chasing an error that was not there...
Image

I had to merge the script into my existing eventhandlers.vbs which is now over 1.100 lines :roll:
Hi Soren that's excellent news thanks!

So am I adding that line? or replacing Set f = fs.OpenTextFile(outgoingexceptions, ForReading) with Set f = OpenFile(outgoingexceptions, ForReading)

I'm not to sure what changes I need to make in my existing script, I take no claim to fame in knowing how this script is supposed to work, it's just been plopped in my lap and I'm trying to make heads or tails out of it.

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

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-20 16:58

EcHoOfInSaNiTy wrote:So am I adding that line? or replacing Set f = fs.OpenTextFile(outgoingexceptions, ForReading) with Set f = OpenFile(outgoingexceptions, ForReading)
There are a few more changes than that..
EcHoOfInSaNiTy wrote:I'm not to sure what changes I need to make in my existing script, I take no claim to fame in knowing how this script is supposed to work, it's just been plopped in my lap and I'm trying to make heads or tails out of it.
Oh man.. It's going to be a long day :wink:

Ok.. You need to compare your Eventhandlers.vbs file to the script. Are there any other codelines in there which is not in the script - then you have additional functionality in there you need to get your head around.

If the script (that was published here) is the sole content of your Eventhandlers.vbs then have a look at the first lines under "General" and "User and Domain outgoing limitation". You need to transfer these configurations to the new script.

BEFORE ANYTHING !!! MAKE A COPY of your original Eventhandlers.vbs file... Just in case :mrgreen:
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

EcHoOfInSaNiTy
Normal user
Normal user
Posts: 42
Joined: 2015-03-13 02:12

Re: hMailServer locks up Randomly

Post by EcHoOfInSaNiTy » 2015-04-20 23:02

SorenR wrote:Someone have a spare test server they don't use ??
This is totally UNTESTED... I'm not sure "Err.Number = 70" is the correct error code to wait for ...

Changes: ...

Functions Wait and OpenFile are new and copied from my own code library...

"Set f = fs.OpenTextFile(..." replaced by "Set f = OpenFile(..."

Code: Select all

'Force error on undeclared variables
Option Explicit

'------------------------------------------------------------------
' SMTP Limit - Global variables and settings
'------------------------------------------------------------------

'General
Public obApp
Public domain_buffer
Public Const ipslocalhost = "Blank for Privacy" 'separated by #
Public Const user = "Administrator"
Public Const pw = "Blank for Privacy" ' ## enter your hmail admin password here

Public Const write_log_active = False

'User and Domain outgoing limitation
Public Const outgoingstore = "c:\program files (x86)\hMailServer\Events\outboundstore.txt"
Public Const outgoingexceptions = "c:\program files (x86)\hMailServer\Events\outboundexceptions.txt"
Public Const outgoingstoreavg = "c:\program files (x86)\hMailServer\Events\outboundstoreavg.txt"
Public Const max_emails_per_user = 130
Public Const max_emails_per_domain = 75000
Public Const warning_factor = 0.8
Public Const server_average_days = 20 ' 0 will deactivate
Public Const server_average_threshold_factor = 10
Public Const warning_factor_avg = 0.6
Public Const msg_AdminName = """Blank for Privacy""" ' ## enter name here. N.B. leave """ as is.
Public Const msg_AdminEmail = "Blank for Privacy" ' ## enter your email admin email address here



Sub OnAcceptMessage(oClient, oMessage)
   Result.Value = 0
   Set obApp = CreateObject("hMailServer.Application")
   Call obApp.Authenticate(user, pw)

   If has_client_authenticated(oClient) Then
      write_log (" User has authenticated. User " & oCLient.username & ", Client " & oClient.IPAddress)
      if not check_outgoing_limitations(oClient, oMessage) Then
         Result.Message = "Your account/Mailserver has passed SMTP outgoing limits."
         Result.Value = 2
      End if
   End if
End Sub

'------------------------------------------------------------------
' SMTP Limit - Functions and Subs for outgoing emails of domain and user
'------------------------------------------------------------------

function check_outgoing_limitations(oClient, oMessage)
   check_outgoing_limitations = true
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs , f
   Set fs = CreateObject("scripting.filesystemobject")
   Dim idt
   Dim content
   Dim ln
   Dim arr
   Dim usern
   Dim usernadd
   Dim usernnr
   Dim usernnrmax
   Dim domn
   Dim domnadd
   Dim domnnr
   Dim domnnrmax
   Dim reason
   Dim rcptscnt
   Dim dayamounts(200)
   Dim i, k

   For i = 0 To 200
      dayamounts(i) = 0
   Next
   Dim pos
   Dim avg
   Dim minday
   minday = 999999
   Dim toindex
   Dim excptn

   write_log(" SMTP outgoing limitations")

   If oclient.username <> "" Then
      If instr(1,oclient.username,"@") = 0 Then
         usern = oclient.username & "@" & obApp.Settings.DefaultDomain
         domn = "@" & obApp.Settings.DefaultDomain
      Else
         usern = oclient.username
         domn = Mid(oclient.username,InStr(1,oclient.username,"@"))
      End If
   ElseIf is_local_domain(omessage.fromaddress) then
      usern = omessage.fromaddress
      domn = Mid(omessage.fromaddress,InStr(1,omessage.fromaddress,"@"))
   Else
      usern = "local"
      domn = "@local"
   End If
   content = "# SMTP outgoing storage" & nl & nl
   usernadd = true
   domnadd = true
   usernnr = 1
   domnnr = 1
   usernnrmax = max_emails_per_user
   domnnrmax = max_emails_per_domain
   idt = CLng(Date())
   rcptscnt = omessage.Recipients.count
   write_log(" Number of recipients " & rcptscnt)

   write_log(" Reading exceptions file " & outgoingexceptions)
   If fs.FileExists(outgoingexceptions) Then
'      Set f = fs.OpenTextFile(outgoingexceptions, ForReading)
      Set f = OpenFile(outgoingexceptions, ForReading)
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         If ln <> "" And Mid(ln,1,1) <> "#" And Len(ln) > 3 Then
            arr = Split(ln,Chr(9))
            If UBound(arr) = 1 Then
               If arr(0) = usern Then
                  usernnrmax = CLng(arr(1))
                  write_log (" new user limit " & ln)
               End if
               If arr(0) = domn Then
                  domnnrmax = CLng(arr(1))
                  write_log (" new domain limit " & ln)
               End if
            Else
               write_log (" cannot process line " & Mid(ln,1,25))
            End If
         ElseIf Len(ln) > 5 And f.Line > 4 + 1 then
            write_log (" skipping line " & Mid(ln,1,25))
         End If
      Loop
   Else
'      Set f = fs.OpenTextFile(outgoingexceptions, ForWriting, true)
      Set f = OpenFile(outgoingexceptions, ForWriting)
      f.Write("# Outgoing limitation exceptions tab / chr(9) separated" & nl)
      f.Write("# Examples (without # at the beginning)" & nl)
      f.Write("# @yourdomain.com 10000" & nl)
      f.Write("# address@yourdomain.com   5000" & nl & nl)
      f.Close
   End If

   write_log(" Reading storage file " & outgoingstore)
   If fs.FileExists(outgoingstore) Then
'      Set f = fs.OpenTextFile(outgoingstore, ForReading)
      Set f = OpenFile(outgoingstore, ForReading)
      Do While Not f.AtEndOfStream
         ln = f.ReadLine
         If ln <> "" And Mid(ln,1,1) <> "#" And Len(ln) > 5 Then
            arr = Split(ln," ")
            If UBound(arr) > 1 Then
               If minday > CLng(arr(0)) Then
                  minday = CLng(arr(0))
               End If
            End If
            If UBound(arr) = 2 Or UBound(arr) = 3 Then
               If CLng(arr(0)) = idt And arr(2) = usern Then
                  usernnr = CLng(arr(1)) + rcptscnt
                  usernadd = False
                  write_log (" adding to line " & ln)
                  If usernnr > usernnrmax Then
                     If UBound(arr) = 3 Then
                        If arr(3) = "X" then
                           write_log (" deny already sent")
                        Else
                           write_log (" sending deny")
                           outgoing_limitations_send_message oClient, oMessage, false, usernnr, usernnrmax, false
                        End if
                     Else
                        write_log (" sending deny")
                        outgoing_limitations_send_message oClient, oMessage, false, usernnr, usernnrmax, false
                     End If
                     content = content & arr(0) & " " & usernnr & " " & arr(2) & " X" & nl
                  ElseIf usernnr > usernnrmax * warning_factor then
                     If UBound(arr) = 3 Then
                        If arr(3) = "W" then
                           write_log (" warning already sent")
                        Else
                           write_log (" sending warning")
                           outgoing_limitations_send_message oClient, oMessage, true, usernnr, usernnrmax, false
                        End if
                     Else
                        write_log (" sending warning")
                        outgoing_limitations_send_message oClient, oMessage, true, usernnr, usernnrmax, false
                     End If
                     content = content & arr(0) & " " & usernnr & " " & arr(2) & " W" & nl
                  Else
                     content = content & arr(0) & " " & usernnr & " " & arr(2) & nl
                  End if
               elseIf CLng(arr(0)) = idt And arr(2) = domn Then
                  domnnr = CLng(arr(1)) + rcptscnt
                  domnadd = false
                  write_log (" adding to line " & ln)
                  If domnnr > domnnrmax Then
                     If UBound(arr) = 3 Then
                        If arr(3) = "X" then
                           write_log (" deny already sent")
                        Else
                           write_log (" sending deny")
                           outgoing_limitations_send_message oClient, oMessage, false, domnnr, domnnrmax, true
                        End if
                     Else
                        write_log (" sending deny")
                        outgoing_limitations_send_message oClient, oMessage, false, domnnr, domnnrmax, true
                     End If
                     content = content & arr(0) & " " & domnnr & " " & arr(2) & " X" & nl
                  ElseIf domnnr > domnnrmax * warning_factor then
                     If UBound(arr) = 3 Then
                        If arr(3) = "W" then
                           write_log (" warning already sent")
                        Else
                           write_log (" sending warning")
                           outgoing_limitations_send_message oClient, oMessage, true, domnnr, domnnrmax, true
                        End if
                     Else
                        write_log (" sending warning")
                        outgoing_limitations_send_message oClient, oMessage, true, domnnr, domnnrmax, true
                     End If
                     content = content & arr(0) & " " & domnnr & " " & arr(2) & " W" & nl
                  Else
                     content = content & arr(0) & " " & domnnr & " " & arr(2) & nl
                  End if
               ElseIf CLng(arr(0)) < idt - server_average_days Then
                  write_log (" deleting line " & ln)
               Else
                  content = content & arr(0) & " " & arr(1) & " " & arr(2) & nl
'write_log (" copying line " & ln)
               End If
               If Mid(arr(2),1,1) <> "@" Then
                  pos = idt - CLng(arr(0))
                  dayamounts(pos) = dayamounts(pos) + CLng(arr(1))
               End If
            Else
               write_log (" cannot process line " & Mid(ln,1,25))
            End If
         ElseIf Len(ln) > 5 And f.Line > 1 + 1 then
            write_log (" skipping line " & Mid(ln,1,25))
         End If
      Loop
      f.Close
      If usernadd Then
         content = content & idt & " " & usernnr & " " & usern & nl
      End If
      If domnadd Then
         content = content & idt & " " & domnnr & " " & domn & nl
      End If
'      Set f = fs.OpenTextFile(outgoingstore, ForWriting, true)
      Set f = OpenFile(outgoingstore, ForWriting)
      f.Write(content)
      f.Close
   Else
      content = content & idt & " " & usernnr & " " & usern & nl
      content = content & idt & " " & domnnr & " " & domn & nl
'      Set f = fs.OpenTextFile(outgoingstore, ForWriting, true)
      Set f = OpenFile(outgoingstore, ForWriting)
      f.Write(content)
      f.Close
   End If

   toindex = idt - minday
   avg = CDbl(0)
   If toindex >=5 then
      For i = 1 To toindex
         avg = avg + CDbl(dayamounts(i))
      Next
      avg = CDbl(avg) / CDbl(toindex)
      write_log(" Statistic calculation over " & server_average_days & " days")
      write_log(" todays amount " & dayamounts(0) & " average " & avg & " maximum " & avg * server_average_threshold_factor)
      write_log(" Checking statistics")
   End If
   If toindex < 5 then
      write_log(" Statistic calculation is only done over at least 5 days. Available days: " & toindex)
   ElseIf avg < 5 Then
      write_log(" average below 5 mails per day, ignoring average statistic")
   ElseIf dayamounts(0) > avg * server_average_threshold_factor Then
      write_log(" todays amount has passed limit of " & avg * server_average_threshold_factor)
      outgoing_limitations_avg_send_admin dayamounts(0),avg * server_average_threshold_factor,false
      check_outgoing_limitations = False
   ElseIf dayamounts(0) > avg * server_average_threshold_factor * warning_factor_avg Then
      write_log(" todays amount has passed warning level of " & avg * server_average_threshold_factor * warning_factor_avg)
      outgoing_limitations_avg_send_admin dayamounts(0),avg * server_average_threshold_factor,true
      check_outgoing_limitations = False
   Else
      write_log(" within limits")
   End If

   write_log(" Checking limits")
   If usernnrmax < usernnr Then
      check_outgoing_limitations = false
      write_log(" max of user passed!")
   ElseIf domnnrmax < domnnr Then
      check_outgoing_limitations = false
      write_log(" max of domain passed!")
   Else
      write_log(" within limits")
   End If

   excptn = false
   If oMessage.FromAddress = msg_AdminEmail Then
      excptn = true
   Else
      For k = 0 To oMessage.recipients.count - 1
         If oMessage.recipients(k).OriginalAddress = msg_AdminEmail Then
            excptn = True
         End If
      Next
   End If
   If excptn = True Then
      write_log(" Mail from/to admin -> passes lock")
      check_outgoing_limitations = true
   End if
End function

Sub outgoing_limitations_avg_send_admin(nr, max, iswarning)
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim fs , f
   Set fs = CreateObject("scripting.filesystemobject")
   Dim txt
   Dim tmp
   Dim nMessage
   Dim str
   Dim out
   Dim snd

   If iswarning Then
      tmp = "Warning: Todays outgoing emails will reach lock soon"

      txt = "Hello " & msg_AdminEmail & nl & nl
      txt = txt & "todays outgoing email will reach avg limit soon." & nl & nl
      txt = txt & "Current amount is " & nr & nl
      txt = txt & "Limit is " & max & nl & nl
      txt = txt & "Regards" & nl
      txt = txt & msg_AdminEmail

      str = "W" & CLng(Date())
   Else
      tmp = "Locked: Todays outgoing emails have passed avg limit"

      txt = "Hello " & msg_AdminEmail & nl & nl
      txt = txt & "todays outgoing email have passed avg limit." & nl & nl
      txt = txt & "Current amount is " & nr & nl
      txt = txt & "Limit is " & max & nl & nl
      txt = txt & "Regards" & nl
      txt = txt & msg_AdminEmail

      str = "X" & CLng(Date())
   End If

   snd = true
   If fs.FileExists(outgoingstoreavg) Then
'      Set f = fs.OpenTextFile(outgoingstoreavg,ForReading)
      Set f = OpenFile(outgoingstoreavg,ForReading)
      out = f.ReadAll
      f.Close
      If out = str Then
         snd = false
      End If
   End If

   If snd then
      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient msg_AdminName, msg_AdminEmail
      nMessage.Subject = tmp
      nMessage.Body = txt
      nMessage.Save

'      Set f = fs.OpenTextFile(outgoingstoreavg,ForWriting,True)
      Set f = OpenFile(outgoingstoreavg,ForWriting)
      f.Write(str)
      f.Close
   End If
End Sub

Sub outgoing_limitations_send_message(oClient, oMessage, iswarning, nr, max, isdomain)
   Dim txt
   Dim tmp
   Dim nMessage
   Dim strAccount
   Dim strFromName
   Dim strFromAddress

   tmp = oMessage.From

   if (InStr(1, oMessage.From, "<", 1) > 0) Then
      strAccount = split(oMessage.From, "<")
      strFromAddress = Replace(strAccount(1), ">", "")
      strFromName = Trim(strAccount(0))
      strFromName = Replace (strFromName, """", "")
   Else
      strFromAddress = oMessage.From
      strAccount = split(oMessage.From, "@")
      strFromName = strAccount(0)
   End If

   If iswarning Then
      txt = "Hello " & tmp & nl & nl
      txt = txt & "You are approaching the limit of sent mail allowed for today." & nl & nl
      txt = txt & "Current messages sent: " & nr & nl
      txt = txt & "Daily limit: " & max & nl & nl
      If isdomain Then
         txt = txt & "This is a limit of your domain." & nl & nl
      Else
         txt = txt & "For more information please visit: Blanked for Privacy" & nl & nl
      End If
      txt = txt & "Regards" & nl
      txt = txt & msg_AdminEmail

      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient strFromName, strFromAddress
      nMessage.Subject = "Warning: Account limits will be reached soon"
      nMessage.Body = txt
      nMessage.Save
   Else
      txt = "Hello " & tmp & nl & nl
      txt = txt & "You have exceeded the allowed sent messages for today. As a result your account is now locked from sending email." & nl & nl
      txt = txt & "Total messages sent: " & nr & nl
      txt = txt & "Daily limit: " & max & nl & nl
      If isdomain Then
         txt = txt & "This is a limit of the your domain." & nl & nl
      Else
         txt = txt & "If you did not personally send 100+ messages today it is very likely that either your computer or email account has been compromised." & nl & nl
      End If
      txt = txt & "Please contact us ASAP to get this situation rectified," & nl & nl
      txt = txt & "Blanked for Privacy" & nl & nl
      txt = txt & msg_AdminEmail

      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient msg_AdminName, msg_AdminEmail
      nMessage.Subject = "Account Locked: Account limits passed"
      nMessage.Body = txt
      nMessage.Save

      Set nMessage = CreateObject("hMailServer.Message")
      nMessage.From = msg_AdminName & " <" & msg_AdminEmail & ">"
      nMessage.FromAddress = msg_AdminEmail
      nMessage.AddRecipient strFromName, strFromAddress
      nMessage.Subject = "Locked: Account limits passed"
      nMessage.Body = txt
      nMessage.Save
   End If
End Sub

'------------------------------------------------------------------
' General functions of all scripts
'------------------------------------------------------------------

Sub write_log(txt)
   If write_log_active then
      EventLog.Write("Limit SMTP Script:"+txt)
   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

Function is_local_domain(domain_or_email)
   is_local_domain = False
   Dim domain
   Dim doms
   Dim alss
   Dim i
   Dim j

   If InStr(1," " & domain_or_email,"@") > 0 Then
      domain = Mid(domain_or_email, InStr(1,domain_or_email,"@") + 1)
   Else
      domain = domain_or_email
   End If

   If domain_buffer = "" then
      i = 0
      Set doms = obapp.Domains
      Do While i <= doms.Count - 1
         Set dom = doms.Item(i)
         domain_buffer = domain_buffer & "#" & dom.Name
         j = 0
         Set alss = dom.DomainAliases
         Do While j <= alss.Count - 1
            Set als = alss.item(j)
            domain_buffer = domain_buffer & "#" & als.AliasName
            j = j + 1
         Loop
         i = i + 1
      Loop
   End If

   If InStr(1, " " & domain_buffer, domain) > 0 Then
      is_local_domain = True
   End If
End Function

Function has_client_authenticated(oclient)
   has_client_authenticated = false
   If oCLient.username <> "" Or InStr(1," " & ipslocalhost, oClient.IPAddress) > 0 Then
      has_client_authenticated = true
   End if
End Function

Function Wait(sec)
   Dim t
   t = Timer
   Do While ((Timer - t) < sec) Xor (Timer < t)
   Loop
End Function

Function OpenFile(strPath, ioMode)
   With CreateObject("Scripting.FileSystemObject")
      Dim oFile, i
      For i = 0 To 30
         On Error Resume Next
         Set oFile = .OpenTextFile(strPath, ioMode, True)
         If (Not Err.Number = 70) Then
            Set OpenFile = oFile
            On Error Goto 0
            Exit For
         End If
         On Error Goto 0
         Wait(1)
      Next
   End With
   Set oFile = Nothing
   If (Err.Number = 70) Then
      EventLog.Write("ERROR: VBScript Function OpenFile")
      EventLog.Write("File " & strPath & " is locked and timeout was exceeded.")
      Err.Clear
   ElseIf (Err.Number <> 0) Then
      EventLog.Write("ERROR: VBScript Function OpenFile")
      EventLog.Write("Error       : " & Err.Number)
      EventLog.Write("Error (hex) : 0x" & Hex(Err.Number))
      EventLog.Write("Source      : " & Err.Source)
      EventLog.Write("Description : " & Err.Description)
      Err.Clear
   End If
End Function
Hi Soren,

So this script that you posted, I am pasting into a new VBScript and copying over my settings under general from my old one? Then i'm reloading it through the GUI to be safe ;)

And I should be comparing the lines to see if there's any differences, would I have to make any adjustments? I'm sorry this is way over my head but I am definitely willing to give it 100 percent!

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

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-20 23:51

EcHoOfInSaNiTy wrote:So this script that you posted, I am pasting into a new VBScript and copying over my settings under general from my old one? Then i'm reloading it through the GUI to be safe ;)
Yes.
EcHoOfInSaNiTy wrote:And I should be comparing the lines to see if there's any differences, would I have to make any adjustments? I'm sorry this is way over my head but I am definitely willing to give it 100 percent!
You should check that you don't have codelines in your Eventhandlers.vbs that IS NOT in the script. IF you do this means that you have additional code in there and then you can NOT just replace it...

If in doubt you can PM me the entire file and I'll have a look.
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

EcHoOfInSaNiTy
Normal user
Normal user
Posts: 42
Joined: 2015-03-13 02:12

Re: hMailServer locks up Randomly

Post by EcHoOfInSaNiTy » 2015-04-21 18:03

SorenR wrote:
EcHoOfInSaNiTy wrote:So this script that you posted, I am pasting into a new VBScript and copying over my settings under general from my old one? Then i'm reloading it through the GUI to be safe ;)
Yes.
EcHoOfInSaNiTy wrote:And I should be comparing the lines to see if there's any differences, would I have to make any adjustments? I'm sorry this is way over my head but I am definitely willing to give it 100 percent!
You should check that you don't have codelines in your Eventhandlers.vbs that IS NOT in the script. IF you do this means that you have additional code in there and then you can NOT just replace it...

If in doubt you can PM me the entire file and I'll have a look.
I feel comfortable PM'ing you the script, I spent an hour looking through it and I didn't find discrepancies which means I was doing it right or I was completely wrong.

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

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-22 14:00

Just for reference it appears that the script was modified by percepts and posted here..

viewtopic.php?p=155959#p155959

Including a manual...
'------------------------------------------------------------------
' SMTP limit outgoing emails of domain and user --- Manual
'------------------------------------------------------------------

1. Activate scripting in hmailserver: 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 entire script into the the eventhandler.vbs file

3b. in case you are using vbs scripts
paste the global variables and settings section 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 check_outgoing_limitations(oClient, oMessage))

Advise: If you are already using automatic whitelisting, ensure the general functions don't exist twice!


4 do the settings (eventhandler.vbs)
ipslocalhost are the ips of the localhost separated by # from where you can send mails without authentification
user and pw is the login data to hmailserver
write_log_active is boolean and instructs the script to log the actions or not


'User and Domain outgoing limitation

outgoingstore is the file where the data is stored
outgoingexceptions here you can enter exceptions, will be created when first executed.
outgoingstoreavg internal file to store data
max_emails_per_user general limit for all users
max_emails_per_domain general limit for all domains
warning_factor warning factor, when the warning will be sent
server_average_days amount of days the script calculates the outbound average
server_average_threshold_factor threshold factor, how much the todays amount can be over the average
warning_factor_avg warning factor for average
msg_AdminName Admin Name (e.g. "Email Admin")
msg_AdminEmail Admin Email Address (e.g. "admin@admindomain.com")


5 save the files and close the editor


6 check syntax of the script in hm


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

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


8 Define individual limits for a user or a domain
File will be created the first time the script is executed.
@domain.com 1234 for domain limitations
a@b.com 5678 for user limitations
Instruction is also in the file.

9 check the event log and see if it works according to your testing
(this script writes writes to hmailserver_events.log in your hmailserver logs folder)

10 The hmailserver_events.log file needs to be cycled since there is no hmail inbuilt procedure for this. To do this setup a windows task scheduler job to run CycleEventLog.vbs (rename CycleEventLog.txt to CycleEventLog.vbs ) on a daily, weekly or monthly cycle according to which you prefer. (daily works best IMO)
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

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

Re: hMailServer locks up Randomly

Post by SorenR » 2015-04-22 14:25

Version 2.3.1 ...
Attachments
LimitSMTP_script.2.3.1.7z
(3.85 KiB) Downloaded 148 times
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

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

Re: hMailServer locks up Randomly

Post by RvdH » 2015-04-22 15:14

Guess this topic should be moved to the 'Scripting' section, this has nothing to do with hmailserver on it's own
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
SorenR
Senior user
Senior user
Posts: 4438
Joined: 2006-08-21 15:38
Location: Denmark

Re: hMailServer locks up Randomly

Post by SorenR » 2015-05-04 14:19

SorenR wrote:Version 2.3.1a ...
Missing "Dim t" added in function WaitTimer().
Attachments
LimitSMTP_script.2.3.1a.7z
(3.85 KiB) Downloaded 204 times
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

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

Re: hMailServer locks up Randomly

Post by jimimaseye » 2015-05-04 14:31

RvdH wrote:Guess this topic should be moved to the 'Scripting' section, this has nothing to do with hmailserver on it's own
The thread started off genuinely with a problem so it is valid to be located where it is. If however, the solution kindly being offered by Soren proves to be an adequate solution for the poster and also useful for others then he may chose to replicate his offering into the Scripting/How to section himself.
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

Post Reply