package Amavis::Custom;
use strict;
use warnings;
no warnings qw(uninitialized redefine);

# Example use of custom hooks, available since amavisd-new-2.5.0

# This code can be placed directly at end of file amavisd.conf,
# or invoked from there by a call to include_config_files such as:
#   include_config_files('/etc/amavisd-custom.conf');
# or specified on amavisd command line by using additional -c options.
#
# It replaces dummy hooks in package Amavis::Custom (in file amavisd)
# with replacement subroutines of the same name, and thus enable them.
#
# The code below demonstrates obtaining and displaying some of the more
# interesting information on each passing mail, and inserting some custom
# header fields in passed mail.
# The example below also illustrates how to use existing code in amavisd
# to interface with a SQL database server (e.g. MySQL or PostgreSQL),
# allowing for persistent connections and automatic reconnect in case
# of a connection failure.
#
# Modifying recipient address, sending a copy to a mailbox quarantine,
# or creating and sending a short notification alert is illustrated.


#testing database:
# $ mysqladmin create user_presence
# $ mysql user_presence
# CREATE TABLE users (
#   email   varchar(255) NOT NULL UNIQUE,
#   present char(1)
# );
# INSERT INTO users VALUES ('test@example.com',       'Y');
# INSERT INTO users VALUES ('absent@example.com',     'N');
# INSERT INTO users VALUES ('postmaster@example.com', 'Y');


# replaces placeholder routines in Amavis::Custom with actual code

use DBI qw(:sql_types);
use DBD::mysql;

use Amavis::Conf qw(:platform :confvars c cr ca $myhostname);
use Amavis::Notify qw(build_mime_entity);
use Amavis::rfc2821_2822_Tools;
use Amavis::Util qw(do_log untaint safe_encode safe_decode);

# MAIL PROCESSING SEQUENCE:
#
# child process initialization
# loop for each mail:
#   receive mail, parse and make available some basic information
#  *custom hook: new() - may inspect info, may load policy banks
#   mail checking and collecting results
#  *custom hook: checks() - called after virus and spam checks but before
#     taking decisions what to do with mail; may inspect or modify results
#   deciding mail fate (lookup on *_lovers, thresholds, ...)
#   quarantining
#   sending notifications (to admin and recip)
#  *custom hook: before_send() - may send other notif., quarantine, modify mail
#   forwarding (unless blocked)
#  *custom hook: after_send() - may suppress DSN, send reports, quarantine
#   sending delivery status notification (if needed)
#   issue main log entry, manage statistics (timing, counters, nanny)
#  *custom hook: mail_done() - may inspect results
# endloop after $max_requests or earlier

# invoked at child process creation time;
# return an object, or just undef when custom checks are not needed
sub new {
  my($class,$conn,$msginfo) = @_;
  my($self) = bless {}, $class;
  my($conn_h) = Amavis::Out::SQL::Connection->new(
    ['DBI:mysql:database=user_presence;host=127.0.0.1', 'user1', 'passwd1'] );
  $self->{'conn_h'} = $conn_h;
  $self;  # returning an object activates further callbacks,
          # returning undef disables them
}

#sub checks {  # may be left out if not needed
#  my($self,$conn,$msginfo) = @_;
#}

sub before_send {
  my($self,$conn,$msginfo) = @_;
  # $self    ... whatever was returned by new()
  # $conn    ... object with information about a SMTP connection
  # $msginfo ... object with info. about a mail message being processed

  my($ll) = 2;  # log level (0 is the most important level, 1, 2,... 5 less so)
  do_log($ll,"CUSTOM: new message");

  # examine some data pertaining to the SMTP connection from client
  # See methods in Amavis::In::Connection for the full set of available data.
  #
  # SMTP client's IP address as a string (IPv4 or IPv6)
  my($client_ip) = $msginfo->client_addr;
  # does client IP address match @mynetworks_maps? (boolean)
  my($is_client_ip_internal) = $msginfo->client_addr_mynets;
  do_log($ll,"CUSTOM: [%s], is internal IP: %s, %s",
           $client_ip, $is_client_ip_internal ? 'YES' : 'NO',
           $msginfo->originating ? 'ORIGINATING' : 'incoming');

  # examine some data pertaining to the message as a whole (not per-pecipient)
  # See methods in Amavis::In::Message for the full set of available data.
  #
  my($log_id)  = $msginfo->log_id;  # log ID string, e.g. '48262-21-2'
  my($mail_id) = $msginfo->mail_id; # long-term unique id, e.g. 'yxqmZgS+M09R'
  my($sender)  = $msginfo->sender;  # envelope sender address, e.g. 'usr@e.com'
  my($mail_size) = $msginfo->msg_size;   # mail size in bytes
  my($spam_level)= $msginfo->spam_level; # spam level (without per-recip boost)
  do_log($ll,"CUSTOM: %d bytes, score: %.2f",
           $log_id,$mail_id,$mail_size,$spam_level);
  do_log($ll,"CUSTOM: Return-Path (env. sender): <%s>", $sender);
  my($sigs_ref) = $msginfo->dkim_signatures_valid;
  do_log($ll,"CUSTOM: dkim valid, d=%s", join(',', map {$_->domain} @$sigs_ref)
        )  if defined $sigs_ref && @$sigs_ref;

  # full mail is only stored in file, which may be read if desired (see below);
  # full mail header is available in ->orig_header;

  # some mail header fields are available through $msginfo->orig_header_fields
  # these may be multiline, may contain folding whitespace or comments;
  # alternatively, the whole original mail header is available in ->orig_header
  my($m_id) = $msginfo->get_header_field_body('message-id');  # e.g. <12@e.n>
  my($subj) = $msginfo->get_header_field_body('subject');
  my($from) = $msginfo->get_header_field_body('from');
    # e.g.: "=?ISO-8859-1?Q?Ren=E9_van_den_Berg?=" <vd@example.com>
  my($is_bulk) = $msginfo->orig_header_fields->{'precedence'};  # e.g. List
  $is_bulk = $is_bulk=~/^[ \t]*(bulk|list|junk)\b/i ? $1 : undef;
  for ($m_id,$from,$subj) {  # RFC2047-decode char. sets in some header fields
    local($1); chomp; my($str);
    s/\n([ \t])/$1/sg; s/^[ \t]+//s; s/[ \t]+\z//s;  # unfold, trim
    eval { $str = safe_decode('MIME-Header',$_) };   # to string of logical chr
    $_ = $str  if $@ eq '';  # replace if all ok, otherwise keep unchanged
  }
  # $m_id, $from, and $subj are now ready for examination - Perl logical chars
  do_log($ll,"CUSTOM: Subject: %s",safe_encode('iso-8859-1',$subj)); #as Latin1
  do_log($ll,"CUSTOM: From: %s", safe_encode('iso-8859-1',$from));  # as Latin1
  # NOTE: rfc2822 allows multiple addresses in the From field!
  my($rfc2822_sender) = $msginfo->rfc2822_sender;  # undef or scalar
  my(@rfc2822_from) = do { my $f = $msginfo->rfc2822_from; ref $f ? @$f : $f };
  do_log($ll,"CUSTOM: From (parsed): %s", join(', ',@rfc2822_from));
  do_log($ll,"CUSTOM: Sender: %s", $rfc2822_sender) if defined $rfc2822_sender;

  my($tempdir) = $msginfo->mail_tempdir;  # working directory for this process
  # $tempdir/parts/  is a directory where mail parts were extracted to
  my($mail_file_name) = $msginfo->mail_text_fn;
  # filename of the original mail, normally $tempdir/email.txt
  do_log($ll,"CUSTOM: temp.dir: %s", $tempdir);
  do_log($ll,"CUSTOM: filename: %s", $mail_file_name);

  # full mail header is available in ->orig_header;
  # some individual header fields are quickly accessible ->orig_header_fields

  # mail body is only stored in file, which may be read if desired
  my($fh) = $msginfo->mail_text;  # file handle of our original mail
  my($line); my($line_cnt) = 0;
# $fh->seek(0,0) or die "Can't rewind mail file: $!";
# for ($! = 0; defined($line = $fh->getline); $! = 0) {
#   $line_cnt++;
#   # examine one $line at a time;  (or read by blocks for speed)
# }
# defined $line || $!==0  or die "Error reading mail file: $!";
# do_log($ll,"CUSTOM: %d lines", $line_cnt);

  my($all_local) = !grep { !$_->recip_is_local } @{$msginfo->per_recip_data};
  if ($all_local) {
    my($hdr_edits) = $msginfo->header_edits;
    my($rly_country) = $msginfo->supplementary_info('RELAYCOUNTRY');
    $hdr_edits->add_header('X-Relay-Countries', $rly_country)
      if defined $rly_country && $rly_country ne '';
    my($languages) = $msginfo->supplementary_info('LANGUAGES');
    $hdr_edits->add_header('X-Spam-Languages', $languages)
      if defined $languages && $languages ne '';
  }

  # examine some data pertaining to the each recipient of the message
  # See methods in Amavis::In::Message::PerRecip for the full set of data.
  #
  my($any_passed) = 0;
  for my $r (@{$msginfo->per_recip_data}) {  # $r contains per-recipient data
    next  if $r->recip_done;  # skip recipient that won't receive a message
    # if all recipients have ->recip_done true, mail will not be passed at all
    $any_passed++;
    my($recip) = $r->recip_addr;  # recipient envelope address, e.g. rc@ex.com
    my($is_local) = $r->recip_is_local; # recipient matches @local_domains_maps
    my($localpart,$domain) = split_address($recip);

    my($spam_level_boost) = $r->recip_score_boost;  # per-recip score contrib.
    # $spam_level + $spam_level_boost   is the actual per-recipient spam score
    my($do_tag)  = $r->is_in_contents_category(CC_CLEAN,1);  # >= tag_level
    my($do_tag2) = $r->is_in_contents_category(CC_SPAMMY);   # >= tag2_level
    my($do_kill) = $r->is_in_contents_category(CC_SPAM);     # >= kill_level
    do_log($ll,"CUSTOM: recip: %s, score: %.2f, %s, %s, %s, %s",
             $recip, $spam_level+$spam_level_boost,
             $is_local ? 'IS LOCAL' : 'not local',
             $do_tag  ? 'tag'  : 'no-tag',
             $do_tag2 ? 'tag2' : 'no-tag2',
             $do_kill ? 'kill' : 'no-kill');

    # don't bother with outgoing mail!
    next  if !$is_local;

    # do a SQL lookup
    my($conn_h) = $self->{'conn_h'};
    $conn_h->begin_work_nontransaction;  # (re)connect if not connected
    #
    my($select_clause) =
      'SELECT present,email FROM users WHERE users.email=?';
    # list of actual arguments replacing '?' placeholders
    my(@pos_args) = ( lc(untaint($recip)) );
    $conn_h->execute($select_clause,@pos_args);  # do the query
    #
    my($a_ref); my($user_is_offline);
    while ( defined($a_ref=$conn_h->fetchrow_arrayref($select_clause)) ) {
      do_log($ll,"CUSTOM: SQL fields %s", join(", ", @$a_ref));
      $user_is_offline = 1  if $a_ref->[0] =~ /^(0|N)$/i;
    }
    $conn_h->finish($select_clause)  if defined $a_ref;  # only if not all read

    if ($user_is_offline) {
      # we have three choices of alerting the recipient:
      #   - redirect his mail to dedicated e-mail address;
      #   - use quarantining code to deliver a copy of the message to
      #     a dedicated address;
      #   - construct and send a notification to a dedicated address
      #
      my($choice) = 0;
      if ($choice == 0) {
        # ignore
      } elsif ($choice == 1) {
        # rewrite address and deliver normally
        my($new_addr) = $localpart . '+redirect' . $domain;
        $r->recip_addr_modified($new_addr);  # replaces delivery address!
      } elsif ($choice == 2) {
        # quarantine (i.e. send a mail copy) to a dedicated mailbox
        # in addition to delivering normally
        my($new_addr) = 'alert+' . $localpart . $domain;
        Amavis::do_quarantine($conn, $msginfo, undef,
                              [$new_addr], 'local:all-%m');
      } elsif ($choice == 3) {
        # construct and send a short notification,
        # in addition to delivering normally
        my($when) = rfc2822_timestamp($msginfo->rx_time);
        my($text) = <<"EOD";
From: Alerting Service <alerter\@$myhostname>
To: <$recip>
Subject: New message from $sender
Message-ID: <AA$log_id\@$myhostname>

A new message just arrived on $when
from $from (return-path <$sender>)
Subject: $subj
EOD
        my($notification) = Amavis::In::Message->new;
        $notification->rx_time($msginfo->rx_time);  # copy the reception time
        $notification->log_id($log_id);  # copy log id
        $notification->delivery_method(c('notify_method'));
        $notification->sender('');  # use null return path to avoid loops
        $notification->sender_smtp('<>');
        my($new_addr) = 'alert+' . $localpart . $domain;
        $notification->recips([$new_addr]);
        # character set is controlled through $hdr_encoding and $bdy_encoding
        #   config variables, defaults to 'iso-8859-1'
        $notification->mail_text(
                         string_to_mime_entity(\$text, $msginfo, undef,0,0));
        Amavis::mail_dispatch($conn, $notification, 1, 0);
        my($n_smtp_resp, $n_exit_code, $n_dsn_needed) =
          one_response_for_all($notification, 0);  # check status
        if ($n_smtp_resp =~ /^2/ && !$n_dsn_needed) {  # ok
        } elsif ($n_smtp_resp =~ /^4/) {
          die "temporarily unable to alert recipient: $n_smtp_resp";
        } else {
          do_log(-1, "FAILED to alert recipient: %s", $n_smtp_resp);
        }
      }
    }

  }
  if (!$any_passed) {
    do_log($ll,"CUSTOM: mail is blocked for all recipients");
  } else {  # will do delivery
    do_log($ll,"CUSTOM: being delivered to %d recips", $any_passed);
    # add a custom header field if desired (for all recipients of this message)
    # $msginfo->header_edits->add_header('X-Amavis-Example',
    #     sprintf("a custom header field, mail contains %d lines",$line_cnt) );
  }
  do_log($ll,"CUSTOM: done");
};

#sub after_send {  # may be left out if not needed
#  my($self,$conn,$msginfo) = @_;
#}

#sub mail_done {  # may be left out if not needed
#  my($self,$conn,$msginfo) = @_;
#}

1;  # insure a defined return

# vacation: see RFC 3834