# Mail::SpamAssassin::Reporter - report a message as spam
# <@LICENSE>
# Copyright 2004 Apache Software Foundation
# 
# Licensed 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>
package Mail::SpamAssassin::Reporter;
use strict;
use bytes;
use Carp;
use POSIX ":sys_wait_h";
use constant HAS_NET_DNS => eval { require Net::DNS; };
use constant HAS_NET_SMTP => eval { require Net::SMTP; };
use vars qw{
  @ISA $VERSION
};
@ISA = qw();
$VERSION = 'bogus';     # avoid CPAN.pm picking up razor ver
###########################################################################
sub new {
  my $class = shift;
  $class = ref($class) || $class;
  my ($main, $msg, $options) = @_;
  my $self = {
    'main'              => $main,
    'msg'               => $msg,
    'options'           => $options,
  };
  $self->{conf} = $self->{main}->{conf};
  bless ($self, $class);
  $self;
}
###########################################################################
sub report {
  my ($self) = @_;
  my $return = 1;
  my $available = 0;
  my $text = $self->{main}->remove_spamassassin_markup ($self->{msg});
  if (!$self->{options}->{dont_report_to_dcc} && $self->is_dcc_available()) {
    if ($self->dcc_report($text)) {
      $available = 1;
      dbg ("SpamAssassin: spam reported to DCC.");
      $return = 0;
    }
    else {
      dbg ("SpamAssassin: could not report spam to DCC.");
    }
  }
  if (!$self->{options}->{dont_report_to_pyzor} && $self->is_pyzor_available()) {
    if ($self->pyzor_report($text)) {
      $available = 1;
      dbg ("SpamAssassin: spam reported to Pyzor.");
      $return = 0;
    }
    else {
      dbg ("SpamAssassin: could not report spam to Pyzor.");
    }
  }
  if (!$self->{options}->{dont_report_to_razor} && $self->is_razor_available()) {
    if ($self->razor_report($text)) {
      $available = 1;
      dbg ("SpamAssassin: spam reported to Razor.");
      $return = 0;
    }
    else {
      dbg ("SpamAssassin: could not report spam to Razor.");
    }
  }
  if (!$self->{options}->{dont_report_to_spamcop} && $self->is_spamcop_available()) {
    if ($self->spamcop_report($text)) {
      $available = 1;
      dbg ("SpamAssassin: spam reported to SpamCop.");
      $return = 0;
    }
    else {
      dbg ("SpamAssassin: could not report spam to SpamCop.");
    }
  }
  $self->delete_fulltext_tmpfile();
  if ( $available == 0 ) {
    warn "SpamAssassin: no Internet hashing methods available, so couldn't report.\n";
  }
  return $return;
}
###########################################################################
sub revoke {
  my ($self) = @_;
  my $return = 1;
  my $text = $self->{main}->remove_spamassassin_markup ($self->{msg});
  if (!$self->{main}->{local_tests_only}
      && !$self->{options}->{dont_report_to_razor}
      && $self->is_razor_available()) # we only work with Razor2
  {
    if ($self->razor_revoke($text)) {
      dbg ("SpamAssassin: spam revoked from Razor.");
      $return = 0;
    }
    else {
      dbg ("SpamAssassin: could not revoke spam from Razor.");
    }
  }
  # This is where you would revoke from DCC and Pyzor but I was unable
  # to find where they supported revoke
  return $return;
}
###########################################################################
# non-public methods.
# This is to reset the alarm before dieing - spamd can die of a stray alarm!
sub adie {
  my $msg = shift;
  alarm 0;
  die $msg;
}
# Close an fh piped to a process, possibly exiting if the process returned nonzero.
# thanks to nix /at/ esperi.demon.co.uk for this.
sub close_pipe_fh {
  my ($self, $fh) = @_;
  return if close ($fh);
  my $exitstatus = $?;
  dbg ("raw exit code: $exitstatus");
  if (WIFEXITED ($exitstatus) && (WEXITSTATUS ($exitstatus))) {
    die "Exited with non-zero exit code " . WEXITSTATUS ($exitstatus) . "\n";
  }
  if (WIFSIGNALED ($exitstatus)) {
    die "Exited due to signal " . WTERMSIG ($exitstatus) . "\n";
  }
}
sub razor_report {
  my ($self, $fulltext, $revoke) = @_;
  my $timeout=$self->{conf}->{razor_timeout};
  my $response;
  # If we passed in a true value for $revoke then we must be revoking
  my $type = (defined($revoke) && $revoke) ? 'revoke' : 'report';
  # razor also debugs to stdout. argh. fix it to stderr...
  if ($Mail::SpamAssassin::DEBUG->{enabled}) {
    open (OLDOUT, ">&STDOUT");
    open (STDOUT, ">&STDERR");
  }
  $self->enter_helper_run_mode();
  # Use Razor2 if it's available
  eval { require Razor2::Client::Agent; };
  if ( !$@ ) {
    eval {
      local ($^W) = 0;    # argh, warnings in Razor
      local $SIG{ALRM} = sub { die "alarm\n" };
      alarm $timeout;
      # everything's in the module!
      my $rc = Razor2::Client::Agent->new("razor-$type");
      if ($rc) {
        my %opt = (
          debug      => $Mail::SpamAssassin::DEBUG->{enabled},
          foreground => 1,
          config     => $self->{conf}->{razor_config}
        );
        $rc->{opt} = \%opt;
        $rc->do_conf() or adie($rc->errstr);
        # Razor2 requires authentication for reporting
        my $ident = $rc->get_ident
          or adie ("Razor2 $type requires authentication");
        my @msg = (\$fulltext);
        my $objects = $rc->prepare_objects( \@msg )
          or adie ("error in prepare_objects");
        $rc->get_server_info() or adie $rc->errprefix("reportit");
        # let's reset the alarm since get_server_info() calls
        # nextserver() which calls discover() which very likely will
        # reset the alarm for us ... how polite.  :(  
        alarm $timeout;
        my $sigs = $rc->compute_sigs($objects)
          or adie ("error in compute_sigs");
        $rc->connect() or adie ($rc->errprefix("reportit"));
        $rc->authenticate($ident) or adie ($rc->errprefix("reportit"));
        $rc->report($objects)     or adie ($rc->errprefix("reportit"));
        $rc->disconnect() or adie ($rc->errprefix("reportit"));
        $response = 1; # Razor 2.14 says that if we get here, we did ok.
      }
      else {
        warn "undefined Razor2::Client::Agent\n";
      }
      alarm 0;
      dbg("Razor2: spam $type, response is \"$response\".");
    };
    alarm 0;
    if ($@) {
      if ( $@ =~ /alarm/ ) {
        dbg("razor2 $type timed out after $timeout secs.");
      } elsif ($@ =~ /could not connect/) {
        dbg("razor2 $type could not connect to any servers");
      } elsif ($@ =~ /timeout/i) {
        dbg("razor2 $type timed out connecting to razor servers");
      } else {
        warn "razor2 $type failed: $! $@";
      }
      undef $response;
    }
  }
  # work around serious brain damage in Razor2 (constant seed)
  srand;
  $self->leave_helper_run_mode();
  if ($Mail::SpamAssassin::DEBUG->{enabled}) {
    open (STDOUT, ">&OLDOUT");
    close OLDOUT;
  }
  if (defined($response) && $response+0) {
    return 1;
  } else {
    return 0;
  }
}
sub razor_revoke {
  my ($self, $fulltext) = @_;
  return $self->razor_report($fulltext, 1);
}
sub dcc_report {
  my ($self, $fulltext) = @_;
  my $timeout=$self->{conf}->{dcc_timeout};
  $self->enter_helper_run_mode();
  # use a temp file here -- open2() is unreliable, buffering-wise,
  # under spamd. :(
  my $tmpf = $self->create_fulltext_tmpfile(\$fulltext);
  eval {
    local $SIG{ALRM} = sub { die "__alarm__\n" };
    local $SIG{PIPE} = sub { die "__brokenpipe__\n" };
    alarm $timeout;
    # Note: not really tainted, these both come from system conf file.
    my $path = Mail::SpamAssassin::Util::untaint_file_path ($self->{conf}->{dcc_path});
    my $opts = '';
    if ( $self->{conf}->{dcc_options} =~ /^([^\;\'\"\0]+)$/ ) {
      $opts = $1;
    }
    my $pid = Mail::SpamAssassin::Util::helper_app_pipe_open(*DCC,
                    $tmpf, 1, $path, "-t", "many", split(' ', $opts));
    $pid or die "$!\n";
    my @ignored = <DCC>;
    $self->close_pipe_fh (\*DCC);
    alarm(0);
    waitpid ($pid, 0);
  };
  alarm 0;
  $self->leave_helper_run_mode();
  
  if ($@) {
    if ($@ =~ /^__alarm__$/) {
      dbg ("DCC -> report timed out after $timeout secs.");
   } elsif ($@ =~ /^__brokenpipe__$/) {
      dbg ("DCC -> report failed: Broken pipe.");
    } else {
      warn ("DCC -> report failed: $@\n");
    }
    return 0;
  }
  return 1;
}
sub pyzor_report {
  my ($self, $fulltext) = @_;
  my $timeout=$self->{conf}->{pyzor_timeout};
  $self->enter_helper_run_mode();
  # use a temp file here -- open2() is unreliable, buffering-wise,
  # under spamd. :(
  my $tmpf = $self->create_fulltext_tmpfile(\$fulltext);
  eval {
    local $SIG{ALRM} = sub { die "__alarm__\n" };
    local $SIG{PIPE} = sub { die "__brokenpipe__\n" };
    alarm $timeout;
    # Note: not really tainted, this comes from system conf file.
    my $path = Mail::SpamAssassin::Util::untaint_file_path ($self->{conf}->{pyzor_path});
    my $opts = '';
    if ( $self->{conf}->{pyzor_options} =~ /^([^\;\'\"\0]+)$/ ) {
      $opts = $1;
    }
    #my $pid = open(PYZOR, join(' ', $path, $opts, "report", "< '$tmpf'", ">/dev/null 2>&1", '|')) || die "$!\n";
    my $pid = Mail::SpamAssassin::Util::helper_app_pipe_open(*PYZOR,
                    $tmpf, 1, $path, split(' ', $opts), "report");
    $pid or die "$!\n";
    my @ignored = <PYZOR>;
    $self->close_pipe_fh (\*PYZOR);
    alarm(0);
    waitpid ($pid, 0);
  };
  alarm 0;
  $self->leave_helper_run_mode();
  if ($@) {
    if ($@ =~ /^__alarm__$/) {
      dbg ("Pyzor -> report timed out after $timeout secs.");
    } elsif ($@ =~ /^__brokenpipe__$/) {
      dbg ("Pyzor -> report failed: Broken pipe.");
    } else {
      warn ("Pyzor -> report failed: $@\n");
    }
    return 0;
  }
  return 1;
}
sub smtp_dbg {
  my ($command, $smtp) = @_;
  dbg("SpamCop -> sent $command");
  my $code = $smtp->code();
  my $message = $smtp->message();
  my $debug;
  $debug .= $code if $code;
  $debug .= ($code ? " " : "") . $message if $message;
  chomp $debug;
  dbg("SpamCop -> received $debug");
  return 1;
}
sub spamcop_report {
  my ($self, $original) = @_;
  # check date
  my $header = $original;
  $header =~ s/\r?\n\r?\n.*//s;
  my $date = Mail::SpamAssassin::Util::receive_date($header);
  if ($date && $date < time - 2*86400) {
    warn ("SpamCop -> message older than 2 days, not reporting\n");
    return 0;
  }
  # message variables
  my $boundary = "----------=_" . sprintf("%08X.%08X",time,int(rand(2**32)));
  while ($original =~ /^\Q${boundary}\E$/m) {
    $boundary .= "/".sprintf("%08X",int(rand(2**32)));
  }
  my $description = "spam report via " . Mail::SpamAssassin::Version();
  my $trusted = $self->{msg}->{metadata}->{relays_trusted_str};
  my $untrusted = $self->{msg}->{metadata}->{relays_untrusted_str};
  my $user = $self->{main}->{'username'} || 'unknown';
  my $host = Mail::SpamAssassin::Util::fq_hostname() || 'unknown';
  my $from = $self->{conf}->{spamcop_from_address} || "$user\@$host";
  # message data
  my %head = (
              'To' => $self->{conf}->{spamcop_to_address},
              'From' => $from,
              'Subject' => 'report spam',
              'Date' => Mail::SpamAssassin::Util::time_to_rfc822_date(),
              'Message-Id' =>
                sprintf("<%08X.%08X@%s>",time,int(rand(2**32)),$host),
              'MIME-Version' => '1.0',
              'Content-Type' => "multipart/mixed; boundary=\"$boundary\"",
              );
  # truncate message
  if (length($original) > $self->{conf}->{spamcop_max_report_size}*1024) {
    substr($original,($self->{conf}->{spamcop_max_report_size}*1024)) = "\n[truncated by SpamAssassin]\n";
  }
  my $body = <<"EOM";
This is a multi-part message in MIME format.
--$boundary
Content-Type: message/rfc822; x-spam-type=report
Content-Description: $description
Content-Disposition: attachment
Content-Transfer-Encoding: 8bit
X-Spam-Relays-Trusted: $trusted
X-Spam-Relays-Untrusted: $untrusted
$original
--$boundary--
EOM
  # compose message
  my $message;
  while (my ($k, $v) = each %head) {
    $message .= "$k: $v\n";
  }
  $message .= "\n" . $body;
  # send message
  my $failure;
  my $mx = $head{To};
  my $hello = Mail::SpamAssassin::Util::fq_hostname() || $from;
  $mx =~ s/.*\@//;
  $hello =~ s/.*\@//;
  for my $rr (Net::DNS::mx($mx)) {
    my $exchange = Mail::SpamAssassin::Util::untaint_hostname($rr->exchange);
    next unless $exchange;
    my $smtp;
    if ($smtp = Net::SMTP->new($exchange,
                               Hello => $hello,
                               Port => 587,
                               Timeout => 10))
    {
      if ($smtp->mail($from) && smtp_dbg("FROM $from", $smtp) &&
          $smtp->recipient($head{To}) && smtp_dbg("TO $head{To}", $smtp) &&
          $smtp->data($message) && smtp_dbg("DATA", $smtp) &&
          $smtp->quit() && smtp_dbg("QUIT", $smtp))
      {
        # tell user we succeeded after first attempt if we previously failed
        warn("SpamCop -> report to $exchange succeeded\n") if defined $failure;
        return 1;
      }
      my $code = $smtp->code();
      my $text = $smtp->message();
      $failure = "$code $text" if ($code && $text);
    }
    $failure ||= "Net::SMTP error";
    chomp $failure;
    warn("SpamCop -> report to $exchange failed: $failure\n");
  }
  return 0;
}
###########################################################################
sub dbg { Mail::SpamAssassin::dbg (@_); }
sub create_fulltext_tmpfile { Mail::SpamAssassin::PerMsgStatus::create_fulltext_tmpfile(@_) }
sub delete_fulltext_tmpfile { Mail::SpamAssassin::PerMsgStatus::delete_fulltext_tmpfile(@_) }
# Use the Dns versions ...  At least something only needs 1 copy of code ...
sub is_dcc_available {
  Mail::SpamAssassin::PerMsgStatus::is_dcc_available(@_);
}
sub is_pyzor_available {
  Mail::SpamAssassin::PerMsgStatus::is_pyzor_available(@_);
}
sub is_razor_available {
  Mail::SpamAssassin::PerMsgStatus::is_razor2_available(@_);
}
sub is_spamcop_available {
  my ($self) = @_;
  return (HAS_NET_DNS &&
          HAS_NET_SMTP &&
          $self->{conf}{scores}{'RCVD_IN_BL_SPAMCOP_NET'});
}
sub enter_helper_run_mode { Mail::SpamAssassin::PerMsgStatus::enter_helper_run_mode(@_); }
sub leave_helper_run_mode { Mail::SpamAssassin::PerMsgStatus::leave_helper_run_mode(@_); }
1;