view release on metacpan or  search on metacpan

lib/Mail/SpamCannibal/SMTPsend.pm  view on Meta::CPAN

    last if $response;
  }
  return () unless $response;	# no answer
  my ($off,$id,$qr,$opcode,$aa,$tc,$rd,$ra,$mbz,$ad,$cd,$rcode,
	$qdcount,$ancount,$nscount,$arcount)
	= gethead(\$response);

  my %mxhosts;
  
  DECODE:
  while(1) {
    last if
	$tc ||
	$opcode != QUERY ||
	$rcode != NOERROR ||
	$qdcount != 1 ||
	$ancount < 1;
        
    my ($get,$put,$parse) = new Net::DNS::ToolKit::RR;
    my ($off,$name,$type,$class) = $get->Question(\$response,$off);
    last unless $class == C_IN;

    foreach(0..$ancount -1) {
      ($off,$name,$type,$class,my($ttl,$rdlength,$pref,$nsname)) =
	$get->next(\$response,$off);
      $mxhosts{"$nsname"} = $pref;
    }
    last;
  }
  local @_ = sort { $mxhosts{$a} <=> $mxhosts{$b} } keys %mxhosts;
}

=item * $rv = sendmessage($message,$to,$from);

Send an email message.

  input:	$message,	# text
		$to,		# name@host.com
		$from,		# optional@otherhost.com
		[optional] $fh	# message spool "from" file handle

If from is omitted, the ENV{USER} is used. If the domain is omitted, the
fully qualified domain name of the host is used.

If the optional $fh is present, then B<sendmessage> will use the
Net::Cmd datasend and dataend methods to send and will spool
all available data from $fh to the target.

  returns:	true on success
		else false

=back

=cut

sub sendmessage {
  my ($message,$to,$from,$fh) = @_;
  $to .= '@' . fqdn()
	unless $to =~ /\@/;
  unless ($from) {
    $from = (getpwuid($<))[0] .'@'. fqdn();
  } elsif( $from !~ /\@/) {
    $from .= '@' . fqdn();
  }
  my $head = 'To: '. $to ."\nFrom: ". $from ."\n";
  my @mxhosts = getMXhosts($to);
  return 0 unless @mxhosts;

  my $smtp;
  foreach(@mxhosts) {
    $smtp = Net::SMTP::->new($_,Hello => fqdn());
    last if $smtp;
  }
  return 0 unless $smtp;
  $smtp->mail($from);
  my $rv = ($smtp->to($to) &&
	    $smtp->data() &&
	    $smtp->datasend($head) &&
	    $smtp->datasend($message))
	? 1 : 0;
  if ($fh) {
    my $buf;
    while (read($fh,$buf,10000)) {
      last unless $smtp->datasend($buf);
    }
  }
  $smtp->dataend();
  $smtp->quit();
  return $rv;
}

=head1 DEPENDENCIES

  Net::DNS::Codes
  Net::DNS::ToolKit
  Sys::Hostname::FQDN
  Net::SMTP
  Mail::SpamCannibal::ScriptSupport
  
=head1 EXPORT_OK

        getMXhosts
        sendmessage

=head1 COPYRIGHT

Copyright 2003 - 2007, Michael Robinton <michael@bizsystems.com>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or 
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.