Delete unwanted attachments with user/domain whitelist

Use this forum if you have problems with a hMailServer script, such as hMailServer WebAdmin or code in an event handler.
Post Reply
kuerbis42
New user
New user
Posts: 3
Joined: 2012-06-28 20:02

Delete unwanted attachments with user/domain whitelist

Post by kuerbis42 » 2021-06-14 12:22

Hi,
in addtion or better: as an alternativ script to this thread "Exclude attachment blocking for a domain name": viewtopic.php?f=9&t=35339&hilit=Exclude ... omain+name (here named ExcludeAtt)

What is equal:
  • both scripts can delete or quarantaine attachments
  • for both scripts it's possible to create a kind of whitelist
  • the user gets a notification
  • you can individual change types and text
the differences:
  • ExcludeAtt: creating a whitelist is a rule, that, if hitting, exit the rule-set (and you must login to hmailserver admintool)
  • ExcludeAtt: changing attachment type must be done in the script itself, with reload script within hmailerser admintool
  • ExcludeAtt: changing notification text later in the script (After the point: do not cahnge anything after this point :-)
  • ExcludeAtt: quarantained files will be overwritten, if they already exists
  • ThisScript: you can have a default user/domain whitelist within the script, but can be replaced on-the-fly by a whitelist-file
  • ThisScript: you can have a default forbidden attachments within the script,but can be replaced on-the-fly by a forbidden-attachment-file
  • ThisScript: changing notification text in the beginning of the script (variable)
  • ThisScript: quarantained files will be numbered, if they are allready exists
Advantage ExcludeAtt: only with administrator password and hmailerser admintool , you are able to make changes
Disadvantage ExcludeAtt: same as above, if you've to change e.g. the user/domain whitelist often

So, this script makes nearly the same, expect a few thinks.

To use this script, you must change the file <hmailserer>\Events\EventHandlers.vbs
(you can put all the content above the original template)
and you have to create a rule with:

Criteria:
Field "from"
Comparsion: "Contains"
Value "@"

Actions:
Run Function: DeleteAttachments

The script itself is here (maybe, one of you finds it useful):
* After writing my complete own script, I take the part with RegEx from the other script, 'cause it's more elegant

Code: Select all

Dim lDebug
lDebug = false

Sub DeleteAttachments(oMessage)
' this routine deletes or quarantines file attachments that have the specified
' FileExtensions. It replaces the functionality of antivirus blocked attachments panel in hmailadmin
' and also has a selectable quarantine option

  Dim Quarantine  ' set to True to Quarantine or False to Delete attachments
  Quarantine = True
  
  Dim cPostmasterMail ' set this to the Postmaster Mail-Address
  cPostmasterMail = "<postmaster@yourdomain.tld>" ' insert the postmaster email address here
  
  Dim QuarantineFolder    'where to store quarantined attachments. This folder must already exist.
  QuarantineFolder = "c:\Attachment-Quarantine\"     ' a backslash  is required
  Dim QuarantineFile

  Dim FileExtensions ' set to the file attachment extensions you want to delete or quarantine
  'default-values here:
  FileExtensions = "(doc|docx|bat|cmd|com|cpl|csh|docm|exe|pif|hta|htb|inf|js|jse|lnk|msi|msp|pif|reg|scf|scr|shs|shb|vbe|vbs|wsf|wsh)"  
  ' You can create a file named FileExtensions.txt placed in the QuarantineFolder 
  ' with either comma or new line separated file extensions, that are not allowed. If "FileExtensions.txt" used (and readable by the script), the default is not used

  Dim UserDomainWL ' set to emails or domains, that are WHITELISTED!
  'you can set this here, or:
  UserDomainWL = ""  ' e.g.: "foo@bar.com,@foobar.net"
  ' or you can create a file named UserDomainWL.txt placed in the QuarantineFolder 
  ' with either comma or new line separated mail/domain-entries, that are WL. If "UserDomainWL.txt" used (and readable by the script), the default is not used

  Dim cNotifyMessage ' Place your message for the receiver here
  ' use vbCrlf as linebreak, for the html-part, they will be replaced with <br>
  ' to insert the filenames, use "[[AttachmentDeleteNotify]]"
  ' If you write in german language, please note, that you have to save this file ANSI-coded
  cNotifyMessage = "------"&vbcrlf&"Alert:"&vbcrlf&"Some attachments deemed potentially dangerous have been deleted from this email."&vbcrlf&"If you are sure that the file is safe, you can ask the sender to compress it into a ZIP file. Then send it as an attachment."& vbcrlf & "EMAIL-ID: " & Left(Right(oMessage.Filename,42),38) & vbcrlf &"Deleted Attachments: [[AttachmentDeleteNotify]]" & vbcrlf & "Other files may have been deleted by the antivirus and notified in a text file attached to this message"&  vbcrlf & vbcrlf & "Admin Mail Server "& cPostmasterMail & vbcrlf&"------"
  ' here a german suggestion: delete this line, if you want to use the english one
  cNotifyMessage = "------"&vbcrlf&"Wichtiger Hinweis:"&vbcrlf&"Einige Dateianhänge in dieser Email sind potentiell unerwünscht und gefährlich."&vbcrlf&"Deshalb wurden sie vom Emailserver in Quarantäne verschoben. Wenn Sie die Anhänge erwartet haben, dann schicken Sie bitte DIESE Email an "& cPostmasterMail &" weiter (persönliche Texte können gelöscht werden)."& vbcrlf & "EMAIL-ID: " & Left(Right(oMessage.Filename,42),38) & vbcrlf & "Die gelöschten Anhänge heissen: "& vbcrlf &  "[[AttachmentDeleteNotify]]" & vbcrlf & vbcrlf & "Sollten weitere Anhänge gelöscht worden sein, so finden Sie weitere Informationen dazu am Ende der Email."& vbcrlf & "Ihr MailServer-Admin"& vbcrlf&"------"
   
 ' change anything below here at your own risk. 
  Dim fso, nAttachment, nFileCounter, tempcontent, AttachmentDeleteNotify, oAttachment, oRegExp ,AllowedUserDomain
  Set fso = CreateObject("Scripting.FileSystemObject") 
  Set oRegExp = new RegExp 
  AttachmentDeleteNotify = Empty
  
  ' first check WL
  	IndividaulWL = ReadIndividualOptionFiles(QuarantineFolder & "UserDomainWL.txt",false)
	If VarType(IndividaulWL) = 11 Then  ' it's Boolean, so no file was read
		if lDebug then
			EventLog.Write("WhiteList=using default: " & UserDomainWL)
		End If
		AllowedUserDomain = split(UserDomainWL,",") 
	Else
		if isArray(IndividaulWL) Then
			AllowedUserDomain = IndividaulWL
		End If
	End If
	
	
	if CheckWhiteList(oMessage.FromAddress,AllowedUserDomain) Then
		Exit Sub ' if whitelisted, no further checks
	End If
  
	tempcontent = ReadIndividualOptionFiles(QuarantineFolder & "FileExtensions.txt",true)
	If VarType(IndividaulWL) <> 11 Then  ' it's NO Boolean, so file was read
		FileExtensions = tempcontent
	End If
	' init RegEx
	with oRegExp
		.Pattern = "^.*\."& FileExtensions & "$" 
		.IgnoreCase = True
		.Global = False
	end with
	' check for forbidden extensions
	For nAttachment = 0 to oMessage.Attachments.Count-1
		
		if (oRegExp.test(oMessage.Attachments(nAttachment).Filename)) Then
			' deleting attachment

			AttachmentDeleteNotify = AttachmentDeleteNotify & oMessage.Attachments(nAttachment).Filename & vbcrlf
			If (Quarantine) Then
				 nFileCounter = 0
				 Do While (fso.FileExists(QuarantineFolder & oMessage.Attachments(nAttachment).Filename &  "_"& oMessage.FromAddress & ".Quarantined_" & nFileCounter)) 
				   ' sometimes people always send same filename with different content - but they are not whitelisted
				   nFileCounter = nFileCounter +1
				 Loop    
				 QuarantineFile = QuarantineFolder & oMessage.Attachments(nAttachment).Filename &  "_"& oMessage.FromAddress & ".Quarantined_" & nFileCounter
				 oMessage.Attachments(nAttachment).SaveAs(QuarantineFile)
				 oMessage.Attachments(nAttachment).Delete
				 EventLog.Write ("Saved Attachment as " & QuarantineFile )
			  Else
				 oMessage.Attachments(nAttachment).Delete
			  End If 

		End If 
	Next
	
  ' Adds a notification to the message
  Set oRegExp = nothing
  If Not IsEmpty(AttachmentDeleteNotify) then
    AttachmentDeleteNotify = replace(cNotifyMessage,"[[AttachmentDeleteNotify]]",AttachmentDeleteNotify)
    
	oMessage.Body= AttachmentDeleteNotify &vbcrlf & oMessage.Body 
		
   if oMessage.HTMLBody <> "" then
		AttachmentDeleteNotify=replace(AttachmentDeleteNotify,vbcrlf,"<br>")   
		oMessage.HTMLBody = AttachmentDeleteNotify & "<br>" & oMessage.HTMLBody 
   end if
   
   oMessage.Save
       
  End If 
End Sub 'DeleteAttachments

Function ReadIndividualOptionFiles(Filename,forRegex)
	' Reads the specified file, if forRegex=true, return value is something like (doc|docx|...)
	' if forRegex=false, return value is an array
	' example file content:
	' emails and domains: joe@foo.com,@foo.net,info@bar.com
	' extensions: .doc,docx,.dot (allowed with or without . (dot), only if forRegEx = true)
	
	
	Dim fso, file, cLine,cInputLine, ResultArray
	Set fso = CreateObject("Scripting.FileSystemObject")
	If fso.FileExists(Filename) Then
		cInputLine = ""
		Set file = fso.OpenTextFile (Filename, 1)
		Do Until file.AtEndOfStream
		  cLine = file.Readline
		  cInputLine =  cInputLine & "," & Trim(lcase(cLine))
		Loop
		file.Close

		cInputLine = mid(cInputLine,2) ' remove trailing ,
		if lDebug then
			EventLog.Write("read file " & Filename & ", content:" & cInputLine)
		End If
		
		If forRegex Then
			cInputLine = Replace(cInputLine,".","") ' remove .
			cInputLine = "(" & Replace(cInputLine,",","|") & ")"  ' make a string for Regex
			if lDebug then
				EventLog.Write("RegEx=" & cInputLine)
			End If
			ReadIndividualOptionFiles = cInputLine
		Else
			ResultArray = split(cInputLine,",")
			if lDebug then
				EventLog.Write("WhiteList=" & cInputLine)
			End If
			ReadIndividualOptionFiles = ResultArray
		End If
	Else 
		EventLog.Write("File " &Filename & " not found, using default values.")
		ReadIndividualOptionFiles = false
	End If
End Function 'ReadIndividualOptionFiles

Function CheckWhiteList(cFromAddress,aWhitelisted)
	Dim lAllowed ' for debug reasons only

	CheckWhiteList = false 'default

	lAllowed =false
	If isArray(aWhitelisted) Then
		For each cAddress  in aWhitelisted
			if (InStr(1, LCase(cFromAddress), cAddress, 1) > 0) Then 
				lAllowed = true
				if lDebug then
					EventLog.Write ("Address is whitelisted:" & cFromAddress)
				End If  
				Exit For
				'Exit Function  'Function CheckWhiteList
			End If
		Next
	End If
	if not lAllowed and lDebug Then
		EventLog.Write ("Attachment: not allowed for " & cFromAddress)
	End If   
	CheckWhiteList = lAllowed
End Function 'CheckWhiteList

So, maybe you give me some comments, hints, or other inforamtion, which may help to make this script effectiv.

Greets, Kuerbis42

Post Reply