Standalone script to send message on STDIN via QMQP. Useful as a Postfix QMQP Transport.

sendqmqp.pl

#!/usr/bin/env perl
############################################################################
# sendqmqp - Qmail QMQP Command-Line Interface/Client
# (c) 2022 BIGLIST.com and Allen M. Fair.  All rights reserved.
#---------------------------------------------------------------------------
# Usage: sendqmqp.pl ip:port sender recipients... < message
############################################################################

package SendQMQP;
use strict 'vars', 'refs';
#use Getopt::Long;
use IO::Socket;
#use JSON;

sub command_line {
  my %opt;
  #GetOptions(\%opt, qw( debug recipientfile help ));
  my ($ip_port, $sender, @recipients) = @ARGV;
  unless (scalar @recipients) {
    print "Usage: sendqmqp 127.0.0.1:631 me\@example.com you\@example.com ... < messsage\n";
    exit;
  }
  my $rc;
  eval {
    my $qmqp = SendQMQP->new(%opt);
    $rc = $qmqp->send(queue=>$ip_port, return_path=>$sender, to=>\@recipients, message_fh=>\*STDIN);
    print "$qmqp->{response}\n" if $qmqp->{response};
  };
  if ($@) {
    my $msg = $@ =~ m|^(.+) at /| ? $1 : $@;
    print "ERROR: $msg\n";
    exit 1;
  }
  $rc ? 0 : 1; # Exit code
}

sub new {
  my ($class, %opt) = @_;
  my $self = {%opt};
  bless $self, $class;
}

#-------------------------------------------------------------------------------------------------
# Sends out an email via QMQP directly to a queue. Replaces qm_insert
# Params: queue=>ip:port, queue_class=name, return_path=>email, verp=>true_Default, to=>email|[emails],
#   recipient_file=>name, message=>string, message_file=>name
# QMQP Format: totlen:msglen:message,rplen:returnpath,reciplen:recipient,reciplen:recipient,...,
#-------------------------------------------------------------------------------------------------

sub send {
  my ($self, %params) = @_;
  my $rcount = $self->create_qmqp_file(%params);
  my $rc = $self->send_qmqp_file(%params, rcount=>$rcount);
  #`cp $params{qmqp_file} ~/out` if $params{qmqp_file}; # For testing
  unlink($self->{qmqp_file}) if -f $self->{qmqp_file};
  $rc; # Success Code
}

# Called from qmqp(), takes a message for delivery and returns a QMQP-formatted temp data file. Returns (file, recipcount)
sub create_qmqp_file {
  my ($self, %params) = @_;
  $self->{qmqp_file} = "/tmp/BL.$$.qmqp_file";
  open(my $fh, ">", $self->{qmqp_file}) or die "Can't open $self->{qmqp_file}!";
  my ($buff);

  # Message: message=>data or message_file=>name. Encode as a Netstring (length:data,)
  if ($params{message_fh}) {
    my $in = $params{message_fh};
    my @lines = <$in>;
    $params{message} = join("", @lines); #?? \r\n ??
    @lines = ();
  }
  if ($params{message}) {
    $fh->print( (length($params{message}) + 1) . ':' . $params{message} . "\n,");
  }
  elsif ($params{message_file}) {
    my @mstat = stat $params{message_file};
    $fh->print(($mstat[7]+1) . ':');
    open(my $mf, "<", $params{message_file}) or die "Could not open $params{message_file} to read!";
    while (read($mf, $buff, 50000)) { $fh->print($buff); }
    close $mf;
    $fh->print("\n,");
  }

  # Return Path (with VERP unless turned off). Encode as a Netstring (length:data,)
  $params{return_path} .= '-@[]' unless (exists($params{verp}) && !$params{verp}) || $params{return_path} =~ /-\@\[\]$/;
  $fh->print( length($params{return_path}) . ':' . $params{return_path} . ',');

  # Recipients: to=>email, to=>[email,...], or recipient_file=>name. Encode as Netstrings (length:data,)
  my $rcount = 0;
  if ( $params{recipient_file} && -f $params{recipient_file} ) {
    open(my $rf, "<", $params{recipient_file}) or die "Could not open $params{recipient_file} to read!";
    while (my $r = <$rf>) {
      chomp $r;
      $fh->print(length($r) . ':' . $r . ',' );
      ++$rcount;
    }
    close $rf;
  } elsif ($params{to} && ref($params{to}) eq 'ARRAY' ) {
    foreach my $r (@{$params{to}}) { $fh->print( length($r) . ':' . $r . ',' ); ++$rcount; }
  } elsif ($params{to}) {
    $fh->print( length($params{to}) . ':' . $params{to} . ',' ); ++$rcount;
  }
  $fh->close();
  return ($rcount);
}

# Send the QMQP-formatted file to: queue=>ip:port or queue_class=>name (we look up the ip:port)
sub send_qmqp_file {
  my ($self, %params) = @_;
  my $fn = $self->{qmqp_file};
  my @fstat = stat $self->{qmqp_file};
  # $params{queue} = "192.168.11.103:636";dput \%params; #test bad IP

  if (!$params{queue} || $params{queue} !~ /\d\./)  {
    open (my $qs, "<", "/var/qmail/control/qmqpservers") or die "No Queue given, qmqpservers file not available";
    my @qmqpservers = <$qs>;
    $params{queue} = shift @qmqpservers;
  }
  my ($ip, $port) = split(/:/, $params{queue});
  $port ||= 628; # Default QMQP Port
  $port += 630 if $port < 100; # queue number to port number

  # Open network connection to the Queue
  # Write the file as a Netstring (length:data,) to the QMQPD process.
  my $socket = new IO::Socket::INET( PeerAddr=>$ip, PeerPort=>$port, Proto=>'tcp', Type=>SOCK_STREAM )
    or die "Unable to open socket to $ip:$port!";
  $socket->print( "$fstat[7]:" );
  open(my $mf, "<", $self->{qmqp_file}) or die "Could not open $self->{qmqp_file} to read!";
  my $buff;
  while (read($mf, $buff, 50000)) { $socket->print($buff); }
  close $mf;
  $socket->print( ',' );
  my $response = <$socket>;
  $socket->close();

  $response = $1 if $response =~ /^\d+:(.*),$/;
  $self->{response} = $response;
  return $response =~ /^K/ ? 1 : 0
}

################################################################################
exit command_line(@ARGV) if $0 =~ /\bsendqmqp.pl$/;
1; # End of Package