System Operations
2016-02-09 04:13:05 UTC
2 different AV scanners dont pick word macro virus.
I am not a perl coder and am trying to get the code below working
Any help with this would be appreciated. Thanks
Slave 1 stderr: Can't call method "parts" on an undefined value at /etc/mail/mimedefang-filter
sub filter {
my($entity, $fname, $ext, $type) = @_;
return if message_rejected(); # Avoid unnecessary work
if (contains_office_macros) {
action_notify_administrator("An attachment of type $type, sent by $Sender for $Recip named $fname contains macros.\n");
my $subject = $entity->head->get('Subject',0);
action_change_header('Subject', "[Warning Attachment $fname contains macros (possible virus):] $Subject");
}
return action_accept();
}
sub filter_multipart {
my($entity, $fname, $ext, $type) = @_;
return if message_rejected(); # Avoid unnecessary work
if (contains_office_macros) {
action_notify_administrator("An attachment of type $type, sent by $Sender for $Recip named $fname contains macros.\n");
my $subject = $entity->head->get('Subject',0);
action_change_header('Subject', "[Warning Attachment $fname contains macros (possible virus):] $Subject");
}
return action_accept();
}
==============================================================================
# These markers were documented at:
#http://blog.rootshell.be/2015/01/08/searching-for-microsoft-office-files-containing-macro/
# as of 2015-01-15
# $entity is a MIME::Entity that's the parsed message
my $marker1 = "\xd0\xcf\x11\xe0";
my $marker2 = "\x00\x41\x74\x74\x72\x69\x62\x75\x74\x00";
sub contains_office_macros
{
my ($self, $entity) = @_;
my @parts = $entity->parts();
if (scalar(@parts) > 0) {
foreach my $part (@parts) {
if ($self->contains_office_macros($part)) {
return 1;
}
}
return 0;
}
my $is_msoffice_extension = 0;
foreach my $attr_name (qw( Content-Disposition.filename Content-Type.name) ) {
my $possible = $entity->head->mime_attr($attr_name);
$possible = decode_mimewords($possible);
if ($possible =~ /\.(doc|docx)$/i) {
$is_msoffice_extension = 1;
last;
}
}
return 0 unless $is_msoffice_extension;
return 0 unless defined($entity->bodyhandle) && defined($entity->bodyhandle->path);
my $fp;
if (!open($fp, '<:raw', $entity->bodyhandle->path)) {
return 0;
}
my $contents;
{
local $/;
$contents = <$fp>;
close($fp);
}
if (index($contents, $marker1) > -1 &&
index($contents, $marker2) > -1) {
return 1;
}
return 0;
}
_______________________________________________
NOTE: If there is a disclaimer or other legal boilerplate in the above
message, it is NULL AND VOID. You may ignore it.
Visit http://www.mimedefang.org and http://www.roaringpenguin.com
MIMEDefang mailing list ***@lists.roaringpenguin.com
http://lists.roaringpenguin.com/mailman/listinfo
I am not a perl coder and am trying to get the code below working
Any help with this would be appreciated. Thanks
Slave 1 stderr: Can't call method "parts" on an undefined value at /etc/mail/mimedefang-filter
sub filter {
my($entity, $fname, $ext, $type) = @_;
return if message_rejected(); # Avoid unnecessary work
if (contains_office_macros) {
action_notify_administrator("An attachment of type $type, sent by $Sender for $Recip named $fname contains macros.\n");
my $subject = $entity->head->get('Subject',0);
action_change_header('Subject', "[Warning Attachment $fname contains macros (possible virus):] $Subject");
}
return action_accept();
}
sub filter_multipart {
my($entity, $fname, $ext, $type) = @_;
return if message_rejected(); # Avoid unnecessary work
if (contains_office_macros) {
action_notify_administrator("An attachment of type $type, sent by $Sender for $Recip named $fname contains macros.\n");
my $subject = $entity->head->get('Subject',0);
action_change_header('Subject', "[Warning Attachment $fname contains macros (possible virus):] $Subject");
}
return action_accept();
}
==============================================================================
# These markers were documented at:
#http://blog.rootshell.be/2015/01/08/searching-for-microsoft-office-files-containing-macro/
# as of 2015-01-15
# $entity is a MIME::Entity that's the parsed message
my $marker1 = "\xd0\xcf\x11\xe0";
my $marker2 = "\x00\x41\x74\x74\x72\x69\x62\x75\x74\x00";
sub contains_office_macros
{
my ($self, $entity) = @_;
my @parts = $entity->parts();
if (scalar(@parts) > 0) {
foreach my $part (@parts) {
if ($self->contains_office_macros($part)) {
return 1;
}
}
return 0;
}
my $is_msoffice_extension = 0;
foreach my $attr_name (qw( Content-Disposition.filename Content-Type.name) ) {
my $possible = $entity->head->mime_attr($attr_name);
$possible = decode_mimewords($possible);
if ($possible =~ /\.(doc|docx)$/i) {
$is_msoffice_extension = 1;
last;
}
}
return 0 unless $is_msoffice_extension;
return 0 unless defined($entity->bodyhandle) && defined($entity->bodyhandle->path);
my $fp;
if (!open($fp, '<:raw', $entity->bodyhandle->path)) {
return 0;
}
my $contents;
{
local $/;
$contents = <$fp>;
close($fp);
}
if (index($contents, $marker1) > -1 &&
index($contents, $marker2) > -1) {
return 1;
}
return 0;
}
_______________________________________________
NOTE: If there is a disclaimer or other legal boilerplate in the above
message, it is NULL AND VOID. You may ignore it.
Visit http://www.mimedefang.org and http://www.roaringpenguin.com
MIMEDefang mailing list ***@lists.roaringpenguin.com
http://lists.roaringpenguin.com/mailman/listinfo