proxmox-spamassassin/upstream/lib/Mail/SpamAssassin/Plugin/OLEVBMacro.pm

# <@LICENSE>
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to you under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at:
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>

=head1 NAME

Mail::SpamAssassin::Plugin::OLEVBMacro - search attached documents for evidence of containing an OLE Macro

=head1 SYNOPSIS

  loadplugin Mail::SpamAssassin::Plugin::OLEVBMacro

  ifplugin Mail::SpamAssassin::Plugin::OLEVBMacro
    body     OLEMACRO eval:check_olemacro()
    describe OLEMACRO Attachment has an Office Macro

    body     OLEMACRO_MALICE eval:check_olemacro_malice()
    describe OLEMACRO_MALICE Potentially malicious Office Macro

    body     OLEMACRO_ENCRYPTED eval:check_olemacro_encrypted()
    describe OLEMACRO_ENCRYPTED Has an Office doc that is encrypted

    body     OLEMACRO_RENAME eval:check_olemacro_renamed()
    describe OLEMACRO_RENAME Has an Office doc that has been renamed

    body     OLEMACRO_ZIP_PW eval:check_olemacro_zip_password()
    describe OLEMACRO_ZIP_PW Has an Office doc that is password protected in a zip

    body     OLEMACRO_CSV eval:check_olemacro_csv()
    describe OLEMACRO_CSV Malicious csv file that tries to exec cmd.exe detected

    body     OLEMACRO_DOWNLOAD_EXE eval:check_olemacro_download_exe()
    describe OLEMACRO_DOWNLOAD_EXE Malicious code inside the Office doc that tries to download a .exe file detected
  endif

=head1 DESCRIPTION

This plugin detects OLE Macro inside documents attached to emails.
It can detect documents inside zip files as well as encrypted documents.

=head1 REQUIREMENT

This plugin requires Archive::Zip and IO::String perl modules.

=head1 USER PREFERENCES

The following options can be used in both site-wide (C<local.cf>) and
user-specific (C<user_prefs>) configuration files to customize how
the module handles attached documents

=cut

package Mail::SpamAssassin::Plugin::OLEVBMacro;
use strict;
use warnings;

use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Util qw(compile_regexp);

use constant HAS_ARCHIVE_ZIP => eval { require Archive::Zip; };
use constant HAS_IO_STRING => eval { require IO::String; };

BEGIN
{
    eval{
      import Archive::Zip qw( :ERROR_CODES :CONSTANTS )
    };
    eval{
      import  IO::String
    };
}

use re 'taint';

use vars qw(@ISA);
@ISA = qw(Mail::SpamAssassin::Plugin);

our $VERSION = '0.52';

# https://www.openoffice.org/sc/compdocfileformat.pdf
# http://blog.rootshell.be/2015/01/08/searching-for-microsoft-office-files-containing-macro/
my $marker1 = "\xd0\xcf\x11\xe0";
my $marker2 = "\x00\x41\x74\x74\x72\x69\x62\x75\x74\x00";
# Office 2003 embedded ole
my $marker2a = "\x01\x00\x4f\x00\x6c\x00\x65\x00\x31\x00\x30\x00\x4e\x00\x61\x00";
# embedded object in rtf files (https://www.biblioscape.com/rtf15_spec.htm)
my $marker3 = "\x5c\x6f\x62\x6a\x65\x6d\x62";
my $marker4 = "\x5c\x6f\x62\x6a\x64\x61\x74";
my $marker5 = "\x5c\x20\x6f\x62\x6a\x64\x61\x74";
# Excel .xlsx encrypted package, thanks to Dan Bagwell for the sample
my $encrypted_marker = "\x45\x00\x6e\x00\x63\x00\x72\x00\x79\x00\x70\x00\x74\x00\x65\x00\x64\x00\x50\x00\x61\x00\x63\x00\x6b\x00\x61\x00\x67\x00\x65";
# .exe file downloaded from external website
my $exe_marker1 = "\x00((https?)://)[-A-Za-z0-9+&@#/%?=~_|!:,.;]{5,1000}[-A-Za-z0-9+&@#/%=~_|]{5,1000}(\.exe|\.cmd|\.bat)([\x06|\x00])";
my $exe_marker2 = "URLDownloadToFileA";

# this code burps an ugly message if it fails, but that's redirected elsewhere
# AZ_OK is a constant exported by Archive::Zip
my $az_ok;
eval '$az_ok = AZ_OK';

# constructor: register the eval rule
sub new {
  my $class = shift;
  my $mailsaobject = shift;

  # some boilerplate...
  $class = ref($class) || $class;
  my $self = $class->SUPER::new($mailsaobject);
  bless ($self, $class);

  $self->set_config($mailsaobject->{conf});

  $self->register_eval_rule("check_olemacro");
  $self->register_eval_rule("check_olemacro_csv");
  $self->register_eval_rule("check_olemacro_malice");
  $self->register_eval_rule("check_olemacro_renamed");
  $self->register_eval_rule("check_olemacro_encrypted");
  $self->register_eval_rule("check_olemacro_zip_password");
  $self->register_eval_rule("check_olemacro_download_exe");

  return $self;
}

sub dbg {
  Mail::SpamAssassin::Plugin::dbg ("OLEVBMacro: @_");
}

sub set_config {
  my ($self, $conf) = @_;
  my @cmds = ();

  push(@cmds, {
    setting => 'olemacro_num_mime',
    default => 5,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
  });

=over 4

=item olemacro_num_mime (default: 5)

Configure the maximum number of matching MIME parts the plugin will scan

=back

=cut

  push(@cmds, {
    setting => 'olemacro_num_zip',
    default => 8,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
  });

=over 4

=item olemacro_num_zip (default: 8)

Configure the maximum number of matching zip members the plugin will scan

=back

=cut

  push(@cmds, {
    setting => 'olemacro_zip_depth',
    default => 2,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
  });

=over 4

=item olemacro_zip_depth (default: 2)

Depth to recurse within Zip files

=back

=cut

  push(@cmds, {
    setting => 'olemacro_extended_scan',
    default => 0,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_BOOL,
  });

=over 4

=item olemacro_extended_scan ( 0 | 1 ) (default: 0)

Scan more files for potential macros, the C<olemacro_skip_exts> parameter will still be honored.
This parameter is off by default, this option is needed only to run
C<eval:check_olemacro_renamed> rule.
If this is turned on consider adjusting values for C<olemacro_num_mime> and C<olemacro_num_zip>
and prepare for more CPU overhead

=back

=cut

  push(@cmds, {
    setting => 'olemacro_prefer_contentdisposition',
    default => 1,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_BOOL,
  });

=over 4

=item olemacro_prefer_contentdisposition ( 0 | 1 ) (default: 1)

Choose if the content-disposition header filename be preferred if ambiguity is encountered whilst trying to get filename

=back

=cut

  push(@cmds, {
    setting => 'olemacro_max_file',
    default => 1024000,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
  });

=over 4

=item olemacro_max_file (default: 1024000)

Configure the largest file that the plugin will decode from the MIME objects

=back

=cut

  # https://blogs.msdn.microsoft.com/vsofficedeveloper/2008/05/08/office-2007-file-format-mime-types-for-http-content-streaming-2/
  # https://technet.microsoft.com/en-us/library/ee309278(office.12).aspx

  push(@cmds, {
    setting => 'olemacro_exts',
    default => qr/(?:doc|docx|dot|pot|ppa|pps|ppt|rtf|sldm|xl|xla|xls|xlsx|xlt|xltx|xslb)$/,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
    code => sub {
      my ($self, $key, $value, $line) = @_;
      unless (defined $value && $value !~ /^$/) {
        return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
      }
      my ($rec, $err) = compile_regexp($value, 0);
      if (!$rec) {
       dbg("config: invalid olemacro_exts '$value': $err");
       return $Mail::SpamAssassin::Conf::INVALID_VALUE;
      }
      $self->{olemacro_exts} = $rec;
      },
    }
  );

=over 4

=item olemacro_exts (default: (?:doc|docx|dot|pot|ppa|pps|ppt|rtf|sldm|xl|xla|xls|xlsx|xlt|xltx|xslb)$)

Set the case-insensitive regexp used to configure the extensions the plugin
targets for macro scanning

=back

=cut

  push(@cmds, {
    setting => 'olemacro_macro_exts',
    default => qr/(?:docm|dotm|ppam|potm|ppst|ppsm|pptm|sldm|xlm|xlam|xlsb|xlsm|xltm|xltx|xps)$/,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
    code => sub {
      my ($self, $key, $value, $line) = @_;
      unless (defined $value && $value !~ /^$/) {
        return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
      }
      my ($rec, $err) = compile_regexp($value, 0);
      if (!$rec) {
       dbg("config: invalid olemacro_macro_exts '$value': $err");
       return $Mail::SpamAssassin::Conf::INVALID_VALUE;
      }
      $self->{olemacro_macro_exts} = $rec;
    },
  });

=over 4

=item olemacro_macro_exts (default: (?:docm|dotm|ppam|potm|ppst|ppsm|pptm|sldm|xlm|xlam|xlsb|xlsm|xltm|xltx|xps)$)

Set the case-insensitive regexp used to configure the extensions the plugin
treats as containing a macro

=back

=cut

  push(@cmds, {
    setting => 'olemacro_skip_exts',
    default => qr/(?:dotx|potx|ppsx|pptx|sldx)$/,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
    code => sub {
      my ($self, $key, $value, $line) = @_;
      unless (defined $value && $value !~ /^$/) {
        return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
      }
      my ($rec, $err) = compile_regexp($value, 0);
      if (!$rec) {
       dbg("config: invalid olemacro_skip_exts '$value': $err");
       return $Mail::SpamAssassin::Conf::INVALID_VALUE;
      }

      $self->{olemacro_skip_exts} = $rec;
    },
  });

=over 4

=item olemacro_skip_exts (default: (?:dotx|potx|ppsx|pptx|sldx|xltx)$)

Set the case-insensitive regexp used to configure extensions for the plugin
to skip entirely, these should only be guaranteed macro free files

=back

=cut

  push(@cmds, {
    setting => 'olemacro_skip_ctypes',
    default => qr/^(?:text\/)/,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
    code => sub {
      my ($self, $key, $value, $line) = @_;
      unless (defined $value && $value !~ /^$/) {
        return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
      }
      my ($rec, $err) = compile_regexp($value, 0);
      if (!$rec) {
       dbg("config: invalid olemacro_skip_ctypes '$value': $err");
       return $Mail::SpamAssassin::Conf::INVALID_VALUE;
      }

      $self->{olemacro_skip_ctypes} = $rec;
    },
  });

=over 4

=item olemacro_skip_ctypes (default: ^(?:text\/))

Set the case-insensitive regexp used to configure content types for the
plugin to skip entirely, these should only be guaranteed macro free

=back

=cut

  push(@cmds, {
    setting => 'olemacro_zips',
    default => qr/(?:zip)$/,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
    code => sub {
      my ($self, $key, $value, $line) = @_;
      unless (defined $value && $value !~ /^$/) {
        return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
      }
      my ($rec, $err) = compile_regexp($value, 0);
      if (!$rec) {
       dbg("config: invalid olemacro_zips '$value': $err");
       return $Mail::SpamAssassin::Conf::INVALID_VALUE;
      }

      $self->{olemacro_zips} = $rec;
    },
  });

=over 4

=item olemacro_zips (default: (?:zip)$)

Set the case-insensitive regexp used to configure extensions for the plugin
to target as zip files, files listed in configs above are also tested for zip

=back

=cut

  $conf->{parser}->register_commands(\@cmds);
}

sub check_olemacro {
  my ($self,$pms,$body,$name) = @_;

  _check_attachments(@_) unless exists $pms->{olemacro_exists};

  return $pms->{olemacro_exists};
}

sub check_olemacro_csv {
  my ($self,$pms,$body,$name) = @_;

  my $chunk_size = $pms->{conf}->{olemacro_max_file};

  foreach my $part ($pms->{msg}->find_parts(qr/./, 1)) {

    next unless ($part->{type} eq "text/plain");

    my ($ctt, $ctd, $cte, $name) = _get_part_details($pms, $part);
    next unless defined $ctt;

    next if $name eq '';

    # we skipped what we need/want to
    my $data = undef;

    # if name extension is csv - return true
    if ($name =~ /\.csv/i) {
      dbg("Found csv file with name $name");
      $data = $part->decode($chunk_size) unless defined $data;
      if($data =~ /MSEXCEL\|.{1,20}Windows\\System32\\cmd\.exe/) {
        $pms->{olemacro_csv} = 1;
      }
    }
  }
  return $pms->{olemacro_csv};
}

sub check_olemacro_malice {
  my ($self,$pms,$body,$name) = @_;

  _check_attachments(@_) unless exists $pms->{olemacro_malice};

  return $pms->{olemacro_malice};
}

sub check_olemacro_renamed {
  my ($self,$pms,$body,$name) = @_;

  _check_attachments(@_) unless exists $pms->{olemacro_renamed};

  if ( $pms->{olemacro_renamed} == 1 ) {
    dbg("Found Office document with a renamed macro");
  }

  return $pms->{olemacro_renamed};
}

sub check_olemacro_encrypted {
  my ($self,$pms,$body,$name) = @_;

  _check_attachments(@_) unless exists $pms->{olemacro_encrypted};

  return $pms->{olemacro_encrypted};
}

sub check_olemacro_zip_password {
  my ($self,$pms,$body,$name) = @_;

  _check_attachments(@_) unless exists $pms->{olemacro_zip_password};

  return $pms->{olemacro_zip_password};
}

sub check_olemacro_download_exe {
  my ($self,$pms,$body,$name) = @_;

  _check_attachments(@_) unless exists $pms->{olemacro_download_exe};

  return $pms->{olemacro_download_exe};
}

sub _check_attachments {

  my ($self,$pms,$body,$name) = @_;

  my $mimec = 0;
  my $chunk_size = $pms->{conf}->{olemacro_max_file};

  $pms->{olemacro_exists} = 0;
  $pms->{olemacro_malice} = 0;
  $pms->{olemacro_renamed} = 0;
  $pms->{olemacro_encrypted} = 0;
  $pms->{olemacro_zip_password} = 0;
  $pms->{olemacro_office_xml} = 0;

  foreach my $part ($pms->{msg}->find_parts(qr/./, 1)) {

    next if ($part->{type} =~ /$pms->{conf}->{olemacro_skip_ctypes}/i);

    my ($ctt, $ctd, $cte, $name) = _get_part_details($pms, $part);
    next unless defined $ctt;

    next if $name eq '';
    next if ($name =~ /$pms->{conf}->{olemacro_skip_exts}/i);

    # we skipped what we need/want to
    my $data = undef;

    # if name is macrotype - return true
    if ($name =~ /$pms->{conf}->{olemacro_macro_exts}/i) {
      dbg("Found macrotype attachment with name $name");
      $pms->{olemacro_exists} = 1;

      $data = $part->decode($chunk_size) unless defined $data;

      if (defined $data) {
        _check_encrypted_doc($pms, $name, $data);
        _check_macrotype_doc($pms, $name, $data);
      }

      return 1 if $pms->{olemacro_exists} == 1;
    }

    # if name is ext type - check and return true if needed
    if ($name =~ /$pms->{conf}->{olemacro_exts}/i) {
      dbg("Found attachment with name $name");
      $data = $part->decode($chunk_size) unless defined $data;

      if (defined $data) {
        _check_encrypted_doc($pms, $name, $data);
        _check_oldtype_doc($pms, $name, $data);
        # zipped doc that matches olemacro_exts - strange
        if (_check_macrotype_doc($pms, $name, $data)) {
          $pms->{olemacro_renamed} = $pms->{olemacro_office_xml};
        }
      }

      return 1 if $pms->{olemacro_exists} == 1;
    }

    if ($name =~ /$pms->{conf}->{olemacro_zips}/i) {
      dbg("Found zip attachment with name $name");
      $data = $part->decode($chunk_size) unless defined $data;

      if (defined $data) {
        _check_zip($pms, $name, $data);
      }

      return 1 if $pms->{olemacro_exists} == 1;
    }

    if ((defined $data) and ($data =~ /$exe_marker1/) and (index($data, $exe_marker2))) {
      dbg('Url that triggers a download to an .exe file found in Office file');
      $pms->{olemacro_download_exe} = 1;
    }

    if ($pms->{conf}->{olemacro_extended_scan} == 1) {
      dbg("Extended scan attachment with name $name");
      $data = $part->decode($chunk_size) unless defined $data;

      if (defined $data) {
        if (_is_office_doc($data)) {
          $pms->{olemacro_renamed} = 1;
          dbg("Found $name to be an Office Doc!");
          _check_encrypted_doc($pms, $name, $data);
          _check_oldtype_doc($pms, $name, $data);
        }

        if (_check_macrotype_doc($pms, $name, $data)) {
          $pms->{olemacro_renamed} = $pms->{olemacro_office_xml};
        }

        _check_zip($pms, $name, $data);
      }

      return 1 if $pms->{olemacro_exists} == 1;
    }

    # if we get to here with data a part has been scanned nudge as reqd
    $mimec+=1 if defined $data;
    if ($mimec >= $pms->{conf}->{olemacro_num_mime}) {
      dbg('MIME limit reached');
      last;
    }
  dbg("No Marker of a Macro found in file $name");
  }
  return 0;
}

sub _check_zip {
  my ($pms, $name, $data, $depth) = @_;

  if (!HAS_ARCHIVE_ZIP) {
    warn "check_zip not supported, required module Archive::Zip missing\n";
    return 0;
  }
  return 0 if $pms->{conf}->{olemacro_num_zip} == 0;

  $depth = $depth || 1;
  return 0 if ($depth > $pms->{conf}->{olemacro_zip_depth});

  return 0 unless _is_zip_file($name, $data);
  my $zip = _open_zip_handle($data);
  return 0 unless $zip;

  dbg("Zip opened");

  my $filec = 0;
  my @members = $zip->members();
  # foreach zip member
  # - skip if in skip exts
  # - return 1 if in macro types
  # - check for marker if doc type
  # - check if a zip
  foreach my $member (@members){
    my $mname = lc $member->fileName();
    next if ($mname =~ /$pms->{conf}->{olemacro_skip_exts}/i);

    my $data = undef;
    my $status = undef;

    # if name is macrotype - return true
    if ($mname =~ /$pms->{conf}->{olemacro_macro_exts}/i) {
      dbg("Found macrotype zip member $mname");
      $pms->{olemacro_exists} = 1;

      if ($member->isEncrypted()) {
        dbg("Zip member $mname is encrypted (zip pw)");
        $pms->{olemacro_zip_password} = 1;
        return 1;
      }

      ( $data, $status ) = $member->contents() unless defined $data;
      return 1 unless $status == $az_ok;

      _check_encrypted_doc($pms, $name, $data);
      _check_macrotype_doc($pms, $name, $data);

      return 1 if $pms->{olemacro_exists} == 1;
    }

    if ($mname =~ /$pms->{conf}->{olemacro_exts}/i) {
      dbg("Found zip member $mname");

      if ($member->isEncrypted()) {
        dbg("Zip member $mname is encrypted (zip pw)");
        $pms->{olemacro_zip_password} = 1;
        next;
      }

      ( $data, $status ) = $member->contents() unless defined $data;
      next unless $status == $az_ok;


      _check_encrypted_doc($pms, $name, $data);
      _check_oldtype_doc($pms, $name, $data);
      # zipped doc that matches olemacro_exts - strange
      if (_check_macrotype_doc($pms, $name, $data)) {
        $pms->{olemacro_renamed} = $pms->{olemacro_office_xml};
      }

      return 1 if $pms->{olemacro_exists} == 1;

    }

    if ($mname =~ /$pms->{conf}->{olemacro_zips}/i) {
      dbg("Found zippy zip member $mname");
      ( $data, $status ) = $member->contents() unless defined $data;
      next unless $status == $az_ok;

      _check_zip($pms, $name, $data, $depth);

      return 1 if $pms->{olemacro_exists} == 1;

    }

    if ($pms->{conf}->{olemacro_extended_scan} == 1) {
      dbg("Extended scan attachment with member name $mname");
      ( $data, $status ) = $member->contents() unless defined $data;
      next unless $status == $az_ok;

      if (_is_office_doc($data)) {
        dbg("Found $name to be an Office Doc!");
        _check_encrypted_doc($pms, $name, $data);
        $pms->{olemacro_renamed} = 1;
        _check_oldtype_doc($pms, $name, $data);
      }

      if (_check_macrotype_doc($pms, $name, $data)) {
        $pms->{olemacro_renamed} = $pms->{olemacro_office_xml};
      }

      _check_zip($pms, $name, $data, $depth);

      return 1 if $pms->{olemacro_exists} == 1;

    }

    # if we get to here with data a member has been scanned nudge as reqd
    $filec+=1 if defined $data;
    if ($filec >= $pms->{conf}->{olemacro_num_zip}) {
      dbg('Zip limit reached');
      last;
    }
  }
  return 0;
}

sub _get_part_details {
    my ($pms, $part) = @_;
    #https://en.wikipedia.org/wiki/MIME#Content-Disposition
    #https://github.com/mikel/mail/pull/464

    my $ctt = $part->get_header('content-type');
    return undef unless defined $ctt; ## no critic (ProhibitExplicitReturnUndef)

    my $cte = lc($part->get_header('content-transfer-encoding') || '');
    return undef unless ($cte =~ /^(?:base64|quoted\-printable)$/); ## no critic (ProhibitExplicitReturnUndef)

    $ctt = _decode_part_header($part, $ctt || '');

    my $name = '';
    my $cttname = '';
    my $ctdname = '';

    if($ctt =~ m/(?:file)?name\s*=\s*["']?([^"';]*)["']?/is){
      $cttname = $1;
      $cttname =~ s/\s+$//;
    }

    my $ctd = $part->get_header('content-disposition');
    $ctd = _decode_part_header($part, $ctd || '');

    if($ctd =~ m/filename\s*=\s*["']?([^"';]*)["']?/is){
      $ctdname = $1;
      $ctdname =~ s/\s+$//;
    }

    if (lc $ctdname eq lc $cttname) {
      $name = $ctdname;
    } elsif ($ctdname eq '') {
      $name = $cttname;
    } elsif ($cttname eq '') {
      $name = $ctdname;
    } else {
      if ($pms->{conf}->{olemacro_prefer_contentdisposition}) {
        $name = $ctdname;
      } else {
        $name = $cttname;
      }
    }

    return $ctt, $ctd, $cte, lc $name;
}

sub _open_zip_handle {
  my ($data) = @_;
  # open our archive from raw data
  my $SH = IO::String->new($data);

  Archive::Zip::setErrorHandler( \&_zip_error_handler );
  my $zip = Archive::Zip->new();
  if($zip->readFromFileHandle( $SH ) != $az_ok){
    dbg("cannot read zipfile");
    # as we cannot read it its not a zip (or too big/corrupted)
    # so skip processing.
    return 0;
  }
  return $zip;
}

sub _check_macrotype_doc {
  my ($pms, $name, $data) = @_;

  if (!HAS_IO_STRING) {
    warn "check_macrotype_doc not supported, required module IO::String missing\n";
    return 0;
  }
  return 0 unless _is_zip_file($name, $data);

  my $zip = _open_zip_handle($data);
  return 0 unless $zip;

  # https://www.decalage.info/vba_tools
  # Consider macrofiles as lowercase, they are checked later with a case-insensitive method
  my %macrofiles = (
    'word/vbaproject.bin' => 'word2k7',
    'macros/vba/_vba_project' => 'word97',
    'xl/vbaproject.bin' => 'xl2k7',
    '_vba_project_cur/vba/_vba_project' => 'xl97',
    'ppt/vbaproject.bin' => 'ppt2k7',
  );

  my @members = $zip->members();
  foreach my $member (@members){
    my $mname = lc $member->fileName();
    if (exists($macrofiles{lc($mname)})) {
      dbg("Found $macrofiles{$mname} vba file");
      $pms->{olemacro_exists} = 1;
      last;
    }
  }

  # Look for a member named [Content_Types].xml and do checks
  if (my $ctypesxml = $zip->memberNamed('[Content_Types].xml')) {
    dbg('Found [Content_Types].xml file');
    $pms->{olemacro_office_xml} = 1;
    if (!$pms->{olemacro_exists}) {
      my ( $data, $status ) = $ctypesxml->contents();

      if (($status == $az_ok) && (_check_ctype_xml($data))) {
        $pms->{olemacro_exists} = 1;
      }
    }
  }

  if (($pms->{olemacro_exists}) && (_find_malice_bins($zip))) {
    $pms->{olemacro_malice} = 1;
  }

  return $pms->{olemacro_exists};

}

# Office 2003

sub _check_oldtype_doc {
  my ($pms, $name, $data) = @_;

  if (_check_markers($data)) {
    $pms->{olemacro_exists} = 1;
    if (_check_malice($data)) {
     $pms->{olemacro_malice} = 1;
    }
    return 1;
  }
}

# Encrypted doc

sub _check_encrypted_doc {
  my ($pms, $name, $data) = @_;

  if (_is_encrypted_doc($data)) {
    dbg("File $name is encrypted");
    $pms->{olemacro_encrypted} = 1;
  }

  return $pms->{olemacro_encrypted};
}

sub _is_encrypted_doc {
  my ($data) = @_;

  #http://stackoverflow.com/questions/14347513/how-to-detect-if-a-word-document-is-password-protected-before-uploading-the-file/14347730#14347730
  if (_is_office_doc($data)) {
    if ($data =~ /(?:<encryption xmlns)/i) {
      return 1;
    }
    if (index($data, "\x13") == 523) {
      return 1;
    }
    if (index($data, "\x2f") == 532) {
      return 1;
    }
    if (index($data, "\xfe") == 520) {
      return 1;
    }
    my $tdata = substr $data, 2000;
    $tdata =~ s/\\0/ /g;
    if (index($tdata, "E n c r y p t e d P a c k a g e") > -1) {
      return 1;
    }
    if (index($tdata, $encrypted_marker) > -1) {
      return 1;
    }
  }
}

sub _is_office_doc {
  my ($data) = @_;
  if (index($data, $marker1) == 0) {
    return 1;
  }
}

sub _is_zip_file {
  my ($name, $data) = @_;
  if (index($data, 'PK') == 0) {
    return 1;
  } else {
    return($name =~ /(?:zip)$/i);
  }
}

sub _check_markers {
  my ($data) = @_;

  if (index($data, $marker1) == 0 && index($data, $marker2) > -1) {
    dbg('Marker 1 & 2 found');
    return 1;
  }

  if (index($data, $marker1) == 0 && index($data, $marker2a) > -1) {
    dbg('Marker 1 & 2a found');
    return 1;
  }

  if (index($data, $marker3) > -1) {
    dbg('Marker 3 found');
    return 1;
  }

  if (index($data, $marker4) > -1) {
    dbg('Marker 4 found');
    return 1;
  }

  if (index($data, $marker5) > -1) {
    dbg('Marker 5 found');
    return 1;
  }

  if (index($data, 'w:macrosPresent="yes"') > -1) {
    dbg('XML macros marker found');
    return 1;
  }

  if (index($data, 'vbaProject.bin.rels') > -1) {
    dbg('XML macros marker found');
    return 1;
  }

}

sub _find_malice_bins {
  my ($zip) = @_;

  my @binfiles = $zip->membersMatching( '.*\.bin' );

  foreach my $member (@binfiles){
    my ( $data, $status ) = $member->contents();
    next unless $status == $az_ok;
    if (_check_malice($data)) {
      return 1;
    }
  }
}

sub _check_malice {
  my ($data) = @_;

  # https://www.greyhathacker.net/?p=872
  if ($data =~ /(?:document|auto|workbook)_?open/i) {
    dbg('Found potential malicious code');
    return 1;
  }
}

sub _check_ctype_xml {
  my ($data) = @_;

  # http://download.microsoft.com/download/D/3/3/D334A189-E51B-47FF-B0E8-C0479AFB0E3C/[MS-OFFMACRO].pdf
  if ($data =~ /ContentType=["']application\/vnd\.ms-office\.vbaProject["']/i){
    dbg('Found VBA ref');
    return 1;
  }
  if ($data =~ /macroEnabled/i) {
    dbg('Found Macro Ref');
    return 1;
  }
  if ($data =~ /application\/vnd\.ms-excel\.(?:intl)?macrosheet/i) {
    dbg('Excel macrosheet found');
    return 1;
  }
}

sub _zip_error_handler {
 1;
}

sub _decode_part_header {
  my($part, $header_field_body) = @_;

  return '' unless defined $header_field_body && $header_field_body ne '';

  # deal with folding and cream the newlines and such
  $header_field_body =~ s/\n[ \t]+/\n /g;
  $header_field_body =~ s/\015?\012//gs;

  local($1,$2,$3);

  # Multiple encoded sections must ignore the interim whitespace.
  # To avoid possible FPs with (\s+(?==\?))?, look for the whole RE
  # separated by whitespace.
  1 while $header_field_body =~
            s{ ( = \? [A-Za-z0-9_-]+ \? [bqBQ] \? [^?]* \? = ) \s+
               ( = \? [A-Za-z0-9_-]+ \? [bqBQ] \? [^?]* \? = ) }
             {$1$2}xsg;

  # transcode properly encoded RFC 2047 substrings into UTF-8 octets,
  # leave everything else unchanged as it is supposed to be UTF-8 (RFC 6532)
  # or plain US-ASCII
  $header_field_body =~
    s{ (?: = \? ([A-Za-z0-9_-]+) \? ([bqBQ]) \? ([^?]*) \? = ) }
     { $part->__decode_header($1, uc($2), $3) }xsge;

  return $header_field_body;
}

1;