Dear monks,

I'm attempting to get a form mailer running (the MTA has already been set up and is running smoothly), but for some reason the MTA refuses to accept the connection. Normally when attempting to send a mail from one of the mailboxes, it responds immediately, and the mail in question is delivered (problems would normally occur at the remote end). However, when attempting to send something via the form mailer, things are met with failure.

I have set a null address as a sender for the mailer (it is present in /etc/aliases and I have run newaliases so that cannot be an issue), my mail address as a recipient, and I'm also plugging in the mail address given in the form field both as Cc (if copy has been selected by the submitter) and the Reply-To field.

The following code is in use here: Wrapper function to avoid the same rigmarole at different spots

package sendmail;

require Exporter;
use strict;
use Net::SMTP;
use IO::Socket::SSL;
use checktld;
use Net::DNS::Resolver;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(send_mail);
our $debug = 0;

sub validate_mailaddr
  {
  my $p_email_addr = $_[0];
  my $l_valid_format;
  my $l_dns_error;

  die "validate_mailaddr: Illegal argument count" if(@_ != 1);

  my $l_dns = Net::DNS::Resolver->new( nameservers => [ qw(127.0.0.1) 
+] );

  $p_email_addr =~ /^([^\s@,:"<>]+)@([^\s@,:"<>]+)\.([^\s@,:"<>.\d]{2,
+})$/;

  return undef if(!valid_tld($3));

  $l_dns->query($2.'.'.$3);
  $l_dns_error = $l_dns->errorstring;

  return undef if($l_dns_error eq 'NXDOMAIN');
  return undef if($l_dns_error ne 'NOERROR');

  return "$1\@$2.$3";
  };

sub send_mail
  {
my $p_sender;   
my $p_recipient;
my $p_response_path;
my $p_cc;
my $p_subject;   
my $p_message;   
my $l_result = 1;
my $l_mailer;  
my $l_status;  
my $l_eval_err;

  die "send_mail: Illegal argument count" if(@_ != 6);

  ($p_sender,$p_recipient,$p_response_path,$p_cc,$p_subject,$p_message
+) = @_;

  print STDERR "Sanity check of recipient address...\n" if($p_debug);
  return 0 if(!defined ($p_recipient = validate_mailaddr($p_recipient)
+));
  print STDERR "Sanity check of response path address...\n" if($p_debu
+g && $p_response_path ne '');
  if($p_response_path ne '')
    {
    return 0 if(!defined ($p_response_path = validate_mailaddr($p_resp
+onse_path)));
    }

  print STDERR "$p_recipient\n" if($debug);

$l_mailer = Net::SMTP->new( 'localhost',
                            Hello => '<insert domain name here>',
                            Timeout => 60,
                            SSL => 1 );

  return undef if(!defined $l_mailer);

  $l_status = eval
    {
    print STDERR "Sending MAIL FROM...\n" if($debug);
    $l_mailer->mail($p_sender);
    print STDERR "Attempting RCPT TO...\n" if($debug);
    if($l_mailer->to($p_recipient))
      {
      print STDERR "Sending CC...\n" if($p_cc && $debug);
      $l_mailer->cc($p_response_path) if($p_cc && $p_response_path ne 
+'');
      print STDERR "Sending message data...\n";
      $l_mailer->data();
      $l_mailer->datasend("Content-Type: text/plain; charset=utf-8\n")
+;
      $l_mailer->datasend("From: <$p_sender>\n");
      $l_mailer->datasend("To: <$p_recipient>\n");
      $l_mailer->datasend("Reply-To: <$p_response_path>\n") if($p_resp
+onse_path
      $l_mailer->datasend("Cc: <$p_response_path>\n") if($p_response_p
+ath && $p
      $l_mailer->datasend("Subject: $p_subject\n\n");
      $l_mailer->datasend("$p_message");
      $l_mailer->dataend();

      return "OK";
      }
    else
      { 
      return "Connection refused";
      }
    }; 
  $l_eval_err = $@;

  $l_mailer->quit;

  if($l_eval_err)
    {
    $l_result = 0;

    print STDERR "The transaction failed: $@\n";

    $l_result = -1 if($l_eval_err =~ /Greylisted/);
    }
  if($l_status ne 'OK')
    {
    print STDERR "The transaction failed: $l_status\n";

    return 0;
    }

  return $l_result;
  };

1;
  
__END__
[download]

The TLD check function is defined here (normally the module is auto-generated every now and then to accommodate for possible TLD changes) - this function is called in a plausibility check of the mail addresses:

package checktld;

require Exporter;
use strict;

our @ISA = qw(Exporter);
our @EXPORT = qw(valid_tld);

my @tldlist = ( <insert some tlds here for testing purposes> );

sub valid_tld
  {
my $p_this = $_[0];

  return undef if(@_ != 1);

  foreach (@tldlist)
    {
    return 1 if($p_this eq $_);
    }

  return 0;
  };

1;

__END__
[download]

This is my test case:

#!/usr/bin/perl -wT -I /srv/www1-ssl/cgi-lib

use strict;
use sendmail qw(send_mail);

$sendmail::debug = 1;

my $sender = '<insert sender address here>';
my $destination = '<insert recipient address here>';
my $headline = 'Test';
my $msg = 'This is a test message.';

my $result = send_mail($sender, $destination, '', 0, $headline, $msg);

if($result == 1)
  {
  print "Message sent\n";
  }
elsif($result == -1)
  {
  print "Message transmission temporarily blocked\n";
  }
else
  { 
  print "Transmission failure\n";
  }

__END__
[download]

This is the output of a test run:

Sanity check of recipient address...
<recipient address seen here>
Sending MAIL FROM...
Attempting RCPT TO...
The transaction failed: Connection refused
Transmission failure
[download]

For some reason the ATM detects an error in the transmission sequence and blocks the connection for 30 seconds (a security feature). Now I'm wondering what is going wrong here. FYI, this problem cropped up after upgrading to openSuSE Leap 42.2 - under openSuSE 13.2 things were actually running smoothly...

Thanks for your help.