amavisd-new-qmqpqq.patch

--- amavisd.ori	2016-04-26 21:22:13.525445000 +0200
+++ amavisd	2016-04-26 21:23:36.586286000 +0200
@@ -109,4 +109,5 @@
 #  Amavis::In::SMTP
 #( Amavis::In::Courier )
+#  Amavis::In::QMQPqq
 #  Amavis::Out::SMTP::Protocol
 #  Amavis::Out::SMTP::Session
@@ -5345,4 +5346,5 @@
   # RFC 3848, RFC 6531
   # http://www.iana.org/assignments/mail-parameters/mail-parameters.xhtml
+  # must not use proto name QMQPqq in 'with'
   $s .= "\n with $smtp_proto"
     if $smtp_proto =~ /^ (?: SMTP | (?: ES|L|UTF8S|UTF8L) MTP S? A? ) \z/xsi;
@@ -12107,4 +12109,5 @@
   $extra_code_sql_lookup $extra_code_ldap
   $extra_code_in_ampdp $extra_code_in_smtp $extra_code_in_courier
+  $extra_code_in_qmqpqq
   $extra_code_out_smtp $extra_code_out_pipe
   $extra_code_out_bsmtp $extra_code_out_local $extra_code_p0f
@@ -12134,4 +12137,5 @@
 # Amavis::In::AMPDP, Amavis::In::SMTP and In::Courier objects
 use vars qw($ampdp_in_obj $smtp_in_obj $courier_in_obj);
+use vars qw($qmqpqq_in_obj);            # Amavis::In::QMQPqq object
 
 use vars qw($sql_dataset_conn_lookups); # Amavis::Out::SQL::Connection object
@@ -12870,4 +12874,5 @@
   my(@msg);
   my $euid = $>;  # effective UID
+  do_log(0,"QMQPqq-in proto code %s loaded", $extra_code_in_qmqpqq ?'':" NOT");
   $> = 0;         # try to become root
   POSIX::setuid(0)  if $> != 0;  # and try some more
@@ -13685,5 +13690,9 @@
       die "unavailable support for protocol: $suggested_protocol";
     } elsif ($suggested_protocol eq 'QMQPqq') {
-      die "unavailable support for protocol: $suggested_protocol";
+      if (!$extra_code_in_qmqpqq) {
+        die "incoming TCP connection, but dynamic QMQPqq code not loaded";
+      }
+      $qmqpqq_in_obj = Amavis::In::QMQPqq->new if !$qmqpqq_in_obj;
+      $qmqpqq_in_obj->process_qmqpqq_request($sock,$conn,\&check_mail);
     } elsif ($suggested_protocol eq 'TCP-LOOKUP') { #postfix maps, experimental
       process_tcp_lookup_request($sock, $conn);
@@ -13809,4 +13818,5 @@
   do_log_safe(5,"child_finish_hook: invoking DESTROY methods");
   undef $smtp_in_obj; undef $ampdp_in_obj; undef $courier_in_obj;
+  undef $qmqpqq_in_obj;
   undef $sql_storage; undef $sql_wblist; undef $sql_lookups;
   undef $sql_dataset_conn_lookups; undef $sql_dataset_conn_storage;
@@ -18900,4 +18910,5 @@
     $extra_code_sql_lookup, $extra_code_ldap,
     $extra_code_in_ampdp, $extra_code_in_smtp, $extra_code_in_courier,
+    $extra_code_in_qmqpqq,
     $extra_code_out_smtp, $extra_code_out_pipe,
     $extra_code_out_bsmtp, $extra_code_out_local,
@@ -19251,5 +19262,11 @@
     undef $extra_code_in_courier;
   }
-  if ($needed_protocols_in{'QMQPqq'})  { die "In::QMQPqq code not available" }
+  if ($needed_protocols_in{'QMQPqq'}) {
+    eval $extra_code_in_qmqpqq or die "Problem in the In::QMQPqq code: $@";
+    # release memory occupied by the source code
+    undef $extra_code_in_qmqpqq; $extra_code_in_qmqpqq = 1;
+  } else {
+    undef $extra_code_in_qmqpqq;
+  }
 }
 
@@ -23500,4 +23517,276 @@
 __DATA__
 #
+package Amavis::In::QMQPqq;
+use strict;
+# use re 'taint';   # (is this module ready for this yet?)
+
+BEGIN {
+    use Exporter ();
+    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+    $VERSION = '1.18';
+    @ISA = qw(Exporter);
+}
+use POSIX qw(strftime);
+use Errno qw(ENOENT);
+
+BEGIN {
+    import Amavis::Conf qw(:platform :confvars :dynamic_confvars c cr ca);
+    import Amavis::Util qw(ll do_log am_id new_am_id prolong_timer
+                           debug_oneshot sanitize_str rmdir_recursively);
+    import Amavis::Lookup qw(lookup);
+    import Amavis::Timing qw(section_time);
+    import Amavis::rfc2821_2822_Tools;
+    import Amavis::TempDir;
+    import Amavis::In::Message;
+    import Amavis::In::Connection;
+}
+
+sub new($) {
+    my($class) = @_;
+    my($self) = bless {}, $class;
+    $self->{bytesleft} = undef;		# bytes left for whole package
+    $self->{len} = undef;		# set by getlen() method
+    $self->{sock} = undef;		# connected socket
+    $self->{proto} = undef;		# protocol
+    $self->{tempdir} = Amavis::TempDir->new;	# TempDir object
+    $self->{session_closed_normally} = undef; # closed properly? (waited for K/Z/D)
+    $self;
+}
+
+sub DESTROY {
+  my($self) = shift;
+  eval { do_log(5,"Amavis::In::QMQPqq DESTROY called, sock=%s, normal=%s",
+                  $self->{sock}, $self->{session_closed_normally}) };
+  eval {
+    if (ref($self->{sock}) && ! $self->{session_closed_normally}) {
+      $self->qmqpqq_resp("Z","Service shutting down, closing channel");
+    }
+  };
+  if ($@ ne '')
+    { my($eval_stat) = $@; eval { do_log(1,"QMQPqq shutdown: %s",$eval_stat) } }
+}
+
+# get byte, die if no bytes left
+sub getbyte($) {
+my($self) = shift;
+if(!$self->{bytesleft}--) {
+	die("No bytes left");
+	}
+if(defined($_ = $self->{sock}->getc)) {
+	return($_);
+	}
+die("EOF on socket");
+}
+
+sub getlen($) {
+my($self) = shift;
+my($ch,$len);
+
+for(;;) {
+	$ch = $self->getbyte;
+	if($ch eq ':') {
+		return($self->{len} = $len);
+		}
+	if($ch !~ /^\d$/) {
+		die("Char '$ch' is not a number while determining length");
+		}
+	$len .= $ch;
+	}
+}
+
+sub getcomma($) {
+my($self) = shift;
+if($self->getbyte ne ',') {
+	die("Comma expected, found '$_'");
+	}
+}
+
+sub getnetstring($$) {
+my($self) = shift;
+($self->{sock}->read($_[0],$self->getlen) == $self->{len}) ||
+	die("EOF on socket");
+$self->{bytesleft} -= $self->{len};
+$self->getcomma;
+}
+
+# Accept a QMQPqq connect
+# and call content checking for the message received
+#
+sub process_qmqpqq_request($$$$) {
+my($self,$sock,$conn,$check_mail) = @_;
+# $sock:       connected socket from Net::Server
+# $conn:       information about client connection
+# $check_mail: subroutine ref to be called with file handle
+
+$self->{proto} = "QMQPqq";
+$self->{session_closed_normally} = 0;	# closed properly?
+$self->{sock} = $sock;		# store $sock info for getbyte() method
+$self->{bytesleft} = 20;	# initial bytesleft value, there should
+				# NEVER EVER be longer email than 10^20 (approximately)
+				# bytes but increase if needed ;)
+$self->{len} = undef;
+
+my($msginfo);
+my($sender,@recips);
+my($len);
+
+new_am_id(undef, $Amavis::child_invocation_count, undef);
+Amavis::Timing::init();
+
+$conn->smtp_proto("QMQPqq");  # the name of the method is too specific
+my($eval_stat);
+eval {
+	# get length of whole package
+	$self->{bytesleft} = $self->getlen;
+
+	# get length of 'email'
+	$len = $self->getlen;
+	section_time('initial length determination');
+
+	# prepare tempdir
+	Amavis::check_mail_begin_task();
+	$self->{tempdir}->prepare;
+	$self->{tempdir}->prepare_file;
+
+	$msginfo = Amavis::In::Message->new;
+	$msginfo->rx_time(time);
+	$msginfo->delivery_method(c('forward_method'));
+
+	# get 'email'
+	$self->{tempdir}->empty(0);
+	my $size = 16384;
+	while(($len > 0) && ($sock->read($_,($len >= $size ? $size : $size = $len)) == $size)) {
+		(print {$self->{tempdir}->fh} $_) ||
+			die("Can't write to mail file: $!");
+		$len -= $size;
+		}
+	if($len > 0) {
+		die("EOF on socket");
+		}
+	$self->{tempdir}->fh->flush || die("Can't flush mail file: $!");
+	$self->{tempdir}->fh->seek(0,1) || die("Can't seek on file: $!");
+	$self->{bytesleft} -= $self->{len};
+	section_time('email receiving');
+	# comma has to follow
+	$self->getcomma;
+
+	# get sender (presumably in unquoted form, really???)
+	$self->getnetstring($sender);
+	section_time('sender receiving');
+
+	# get recips (presumably in unquoted form, really???)
+	my $i = 0;
+	while($self->{bytesleft}) {
+		$self->getnetstring($recips[$i++]);
+		}
+	section_time('recips receiving');
+
+	# final comma has to follow
+	$self->{bytesleft} = 1;
+	$self->getcomma;
+		
+	$msginfo->sender($sender);
+	$msginfo->sender_smtp(qquote_rfc2821_local($sender));
+	$msginfo->recips(\@recips);
+		
+	do_log(1, sprintf("%s:%s:%s %s: %s -> %s Received: %s",
+		$self->{proto},$conn->socket_ip eq $inet_socket_bind ?
+			'' : '['.$conn->socket_ip.']',
+		$conn->socket_port, $self->{tempdir_pers},
+		$msginfo->sender_smtp,
+                join(',', map { $_->recip_addr_smtp }
+                              @{$msginfo->per_recip_data}),
+		join(' ',
+			($msginfo->msg_size  eq '' ? ()
+			: 'SIZE='.$msginfo->msg_size),
+			($msginfo->body_type eq '' ? ()
+			: 'BODY='.$msginfo->body_type),
+			received_line($conn,$msginfo,am_id(),0) )
+		));
+
+	$msginfo->mail_tempdir($self->{tempdir}->path);
+	$msginfo->mail_text_fn($self->{tempdir}->path . '/email.txt');
+	$msginfo->mail_text($self->{tempdir}->fh);
+
+	my($smtp_resp,$exit_code,$preserve_evidence) =
+		&$check_mail($conn,$msginfo,0);
+
+	if ($preserve_evidence) { $self->{tempdir}->preserve(1) }
+
+	if ($smtp_resp !~ /^4/ &&
+		grep { !$_->recip_done } @{$msginfo->per_recip_data}) {
+		die("TROUBLE/MISCONFIG: not all recipients done, ".
+			"\$forward_method is \"$forward_method\"");
+		}
+
+	if ($smtp_resp !~ /^4/ &&
+		grep { !$_->recip_done } @{$msginfo->per_recip_data}) {
+		if ($msginfo->delivery_method eq '') {
+			do_log(2,"not all recipients done, forward_method is empty");
+			}
+		else {
+			die "TROUBLE: (MISCONFIG) not all recipients done, " .
+			"forward_method is: " . $msginfo->delivery_method;
+			}
+		}
+
+	# all ok
+	if($smtp_resp =~ /^2/) {
+		$self->qmqpqq_resp("K",$smtp_resp);
+		}
+	# permanent reject
+	elsif($smtp_resp =~ /^5/) {
+		$self->qmqpqq_resp("D",$smtp_resp);
+		}
+	# temporary reject (or other error if !~ /^4/)
+	else {
+		$self->qmqpqq_resp("Z",$smtp_resp);
+		}
+	1;
+} or do {
+	$eval_stat = $@ ne '' ? $@ : "errno=$!";
+};
+
+$self->{tempdir}->clean;
+alarm(0); do_log(4,"timer stopped after QMQPqq eval");
+
+if($eval_stat ne '') {
+	chomp $eval_stat;
+	do_log(0,"QMQPqq: NOTICE: $eval_stat");
+	$self->qmqpqq_resp("Z","Service shutting down, $eval_stat");
+	}
+# report elapsed times by section for each transaction
+do_log(2, "%s", Amavis::Timing::report());
+
+$self->{session_closed_normally} = 1;
+# closes connection after child_finish_hook
+}
+
+# sends a QMQPqq response consisting of K/D/Z code and an optional message;
+# slow down evil clients by delaying response on permanent errors
+sub qmqpqq_resp($$$;$$) {
+my($self,$code,$resp,$penalize,$line) = @_;
+if($code !~ /^(K|Z|D)$/) {
+	die("Internal error(2): bad QMQPqq response code: '$code'");
+	}
+if($penalize) {
+	do_log(0,"QMQPqq: $resp; PENALIZE: $line");
+	sleep 5;
+	section_time('QMQPqq penalty wait');
+	}
+$resp = sanitize_str($resp,1);
+do_log(4,"QMQPqq> $resp");
+$self->{sock}->print($self->netstring($code . $resp));
+}
+
+sub netstring($$) {
+my($self,$string) = @_;
+return(sprintf("%d:%s,",length($string),$string));
+}
+
+1;
+
+__DATA__
+#
 package Amavis::Out::SMTP::Protocol;
 use strict;
--- amavisd.conf.ori	2016-04-26 21:22:22.992355000 +0200
+++ amavisd.conf	2016-04-26 21:23:36.586961000 +0200
@@ -56,6 +56,6 @@
                # option(s) -p overrides $inet_socket_port and $unix_socketname
 
-$inet_socket_port = 10024;   # listen on this local TCP port(s)
-# $inet_socket_port = [10024,10026];  # listen on multiple TCP ports
+$protocol = 'QMQPqq';        # suggested protocol to use on all input sockets
+$inet_socket_port = 10628;   # accept connections on this local TCP port(s)
 
 $policy_bank{'MYNETS'} = {   # mail originating from @mynetworks