hMailServer中文论坛 QQ群:80049760 搭建专业企业级邮件服务器 联系Q3824517

根据N天邮件量的平均值,超出将限制账户。

与hMailServer脚本相关,戳此进入。
回复
头像
Hsia
网站管理员
网站管理员
帖子: 333
注册: 2014年11月26日, 12:41
地址: 上海
联系:

根据N天邮件量的平均值,超出将限制账户。

帖子 Hsia » 2016年3月25日, 09:58

这个脚本,作用是限制某些账号在某一时刻大量发送邮件,在过去N天,该账户的平均值,有限制域名,限制账户,自己修改参数。
使用方法:
1.HM管理工具,设置 - >高级 - >设置 - >脚本 (启用)
2.复制下面的代码到\hMailServer\Events\eventhandler.vbs
3.回到脚本,重新载入脚本,方可生效,每次修改eventhandler.vbs后,都要点击重新载入脚本。

代码: 全选

'Force error on undeclared variables
Option Explicit

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

'General
Public obApp
Public domain_buffer
Public Const ipslocalhost = "0.0.0.0"  'separated by #  
Public Const user = "Administrator"
Public Const pw = "12345678"         ' ## 只需要在这里输入hmailserver的密码。参数根据实际改。

Public Const write_log_active = False

'User and Domain outgoing limitation 下面这个文本自己会建立,设置路径。
Public Const outgoingstore = "D:\hMailServer\Events\outboundstore.txt"
Public Const outgoingexceptions = "D:\hMailServer\Events\outboundexceptions.txt"
Public Const outgoingstoreavg = "D:\hMailServer\Events\outboundstoreavg.txt"
Public Const max_emails_per_user = 40  
Public Const max_emails_per_domain = 100  
Public Const warning_factor = 0.8
Public Const server_average_days = 7     ' 0 will deactivate ##多少天的平均值
Public Const server_average_threshold_factor = 2
Public Const warning_factor_avg = 0.6
Public Const msg_AdminName  = """SERVICE"""    ' ## enter name here. N.B. leave """ as is. 
Public Const msg_AdminEmail = "service@hmailserver.net"   ' ## 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 = "您的帐户/邮件服务器已通过SMTP传出的限制。."
			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 = OpenMyFile(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 = OpenMyFile(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 = OpenMyFile(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 = OpenMyFile(outgoingstore, ForWriting)
		f.Write(content)
		f.Close 
	Else
		content = content & idt & " " & usernnr & " " & usern & nl
		content = content & idt & " " & domnnr & " " & domn & nl
		Set f = OpenMyFile(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 = OpenMyFile(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 = OpenMyFile(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 will soon reach your account limits." & nl & nl
		txt = txt & "Current amount is " & nr & nl
		txt = txt & "Limit is " & max & nl & nl
		If isdomain Then
			txt = txt & "This is a limit of the your domain." & nl & nl
		Else
			txt = txt & "This is a limit of the your account." & 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 msg_AdminName, msg_AdminEmail
		nMessage.Subject = "警告:帐户限制将很快达成"
		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 = "警告:帐户限制将很快达成"
		nMessage.Body = txt
		nMessage.Save
	Else
		txt = "Hello " & tmp & nl & nl
		txt = txt & "你很快就会到达您的帐户限制。." & nl & nl
		txt = txt & "当前是 " & nr & nl
		txt = txt & "限制量 " & max & nl & nl
		If isdomain Then
			txt = txt & "这是你的域名限制." & nl & nl
		Else
			txt = txt & "这是您的帐户限制。." & nl & nl
		End If
		txt = txt & "问候" & 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 = "锁定:帐户限制传递"
		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 = "锁定:帐户限制传递"
		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 dom
	Dim doms
	Dim als
	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 WaitTimer(sec)
	Dim t
	t = Timer
	Do While ((Timer - t) < sec) Xor (Timer < t)
	Loop
End Function

Function OpenMyFile(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 OpenMyFile = oFile
				On Error Goto 0
				Exit For
			End If
			On Error Goto 0
			WaitTimer(1)
		Next
	End With
	Set oFile = Nothing
	If (Err.Number = 70) Then
		EventLog.Write("ERROR: VBScript Function OpenMyFile")
		EventLog.Write("File " & strPath & " is locked and timeout was exceeded.")
		Err.Clear
	ElseIf (Err.Number <> 0) Then
		EventLog.Write("ERROR: VBScript Function OpenMyFile")
		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
该脚本来源于hms官网,地址不记得了,自己找找。

下面是英文的使用说明:

'------------------------------------------------------------------
' 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)

回复