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
- 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
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
Greets, Kuerbis42