1--- amavisd.ori	2017-12-27 16:33:03.000000000 +0100
2+++ amavisd	2018-10-09 14:36:42.767443000 +0200
3@@ -109,4 +109,5 @@
4 #  Amavis::In::SMTP
5 #( Amavis::In::Courier )
6+#  Amavis::In::QMQPqq
7 #  Amavis::Out::SMTP::Protocol
8 #  Amavis::Out::SMTP::Session
9@@ -5351,4 +5352,5 @@
10   # RFC 3848, RFC 6531
11   # http://www.iana.org/assignments/mail-parameters/mail-parameters.xhtml
12+  # must not use proto name QMQPqq in 'with'
13   $s .= "\n with $smtp_proto"
14     if $smtp_proto =~ /^ (?: SMTP | (?: ES|L|UTF8S|UTF8L) MTP S? A? ) \z/xsi;
15@@ -12113,4 +12115,5 @@
16   $extra_code_sql_lookup $extra_code_ldap
17   $extra_code_in_ampdp $extra_code_in_smtp $extra_code_in_courier
18+  $extra_code_in_qmqpqq
19   $extra_code_out_smtp $extra_code_out_pipe
20   $extra_code_out_bsmtp $extra_code_out_local $extra_code_p0f
21@@ -12140,4 +12143,5 @@
22 # Amavis::In::AMPDP, Amavis::In::SMTP and In::Courier objects
23 use vars qw($ampdp_in_obj $smtp_in_obj $courier_in_obj);
24+use vars qw($qmqpqq_in_obj);            # Amavis::In::QMQPqq object
25
26 use vars qw($sql_dataset_conn_lookups); # Amavis::Out::SQL::Connection object
27@@ -12876,4 +12880,5 @@
28   my(@msg);
29   my $euid = $>;  # effective UID
30+  do_log(0,"QMQPqq-in proto code %s loaded", $extra_code_in_qmqpqq ?'':" NOT");
31   $> = 0;         # try to become root
32   POSIX::setuid(0)  if $> != 0;  # and try some more
33@@ -13691,5 +13696,9 @@
34       die "unavailable support for protocol: $suggested_protocol";
35     } elsif ($suggested_protocol eq 'QMQPqq') {
36-      die "unavailable support for protocol: $suggested_protocol";
37+      if (!$extra_code_in_qmqpqq) {
38+        die "incoming TCP connection, but dynamic QMQPqq code not loaded";
39+      }
40+      $qmqpqq_in_obj = Amavis::In::QMQPqq->new if !$qmqpqq_in_obj;
41+      $qmqpqq_in_obj->process_qmqpqq_request($sock,$conn,\&check_mail);
42     } elsif ($suggested_protocol eq 'TCP-LOOKUP') { #postfix maps, experimental
43       process_tcp_lookup_request($sock, $conn);
44@@ -13815,4 +13824,5 @@
45   do_log_safe(5,"child_finish_hook: invoking DESTROY methods");
46   undef $smtp_in_obj; undef $ampdp_in_obj; undef $courier_in_obj;
47+  undef $qmqpqq_in_obj;
48   undef $sql_storage; undef $sql_wblist; undef $sql_lookups;
49   undef $sql_dataset_conn_lookups; undef $sql_dataset_conn_storage;
50@@ -18906,4 +18916,5 @@
51     $extra_code_sql_lookup, $extra_code_ldap,
52     $extra_code_in_ampdp, $extra_code_in_smtp, $extra_code_in_courier,
53+    $extra_code_in_qmqpqq,
54     $extra_code_out_smtp, $extra_code_out_pipe,
55     $extra_code_out_bsmtp, $extra_code_out_local,
56@@ -19257,5 +19268,11 @@
57     undef $extra_code_in_courier;
58   }
59-  if ($needed_protocols_in{'QMQPqq'})  { die "In::QMQPqq code not available" }
60+  if ($needed_protocols_in{'QMQPqq'}) {
61+    eval $extra_code_in_qmqpqq or die "Problem in the In::QMQPqq code: $@";
62+    # release memory occupied by the source code
63+    undef $extra_code_in_qmqpqq; $extra_code_in_qmqpqq = 1;
64+  } else {
65+    undef $extra_code_in_qmqpqq;
66+  }
67 }
68
69@@ -23508,4 +23525,276 @@
70 __DATA__
71 #
72+package Amavis::In::QMQPqq;
73+use strict;
74+# use re 'taint';   # (is this module ready for this yet?)
75+
76+BEGIN {
77+    use Exporter ();
78+    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
79+    $VERSION = '1.18';
80+    @ISA = qw(Exporter);
81+}
82+use POSIX qw(strftime);
83+use Errno qw(ENOENT);
84+
85+BEGIN {
86+    import Amavis::Conf qw(:platform :confvars :dynamic_confvars c cr ca);
87+    import Amavis::Util qw(ll do_log am_id new_am_id prolong_timer
88+                           debug_oneshot sanitize_str rmdir_recursively);
89+    import Amavis::Lookup qw(lookup);
90+    import Amavis::Timing qw(section_time);
91+    import Amavis::rfc2821_2822_Tools;
92+    import Amavis::TempDir;
93+    import Amavis::In::Message;
94+    import Amavis::In::Connection;
95+}
96+
97+sub new($) {
98+    my($class) = @_;
99+    my($self) = bless {}, $class;
100+    $self->{bytesleft} = undef;		# bytes left for whole package
101+    $self->{len} = undef;		# set by getlen() method
102+    $self->{sock} = undef;		# connected socket
103+    $self->{proto} = undef;		# protocol
104+    $self->{tempdir} = Amavis::TempDir->new;	# TempDir object
105+    $self->{session_closed_normally} = undef; # closed properly? (waited for K/Z/D)
106+    $self;
107+}
108+
109+sub DESTROY {
110+  my($self) = shift;
111+  eval { do_log(5,"Amavis::In::QMQPqq DESTROY called, sock=%s, normal=%s",
112+                  $self->{sock}, $self->{session_closed_normally}) };
113+  eval {
114+    if (ref($self->{sock}) && ! $self->{session_closed_normally}) {
115+      $self->qmqpqq_resp("Z","Service shutting down, closing channel");
116+    }
117+  };
118+  if ($@ ne '')
119+    { my($eval_stat) = $@; eval { do_log(1,"QMQPqq shutdown: %s",$eval_stat) } }
120+}
121+
122+# get byte, die if no bytes left
123+sub getbyte($) {
124+my($self) = shift;
125+if(!$self->{bytesleft}--) {
126+	die("No bytes left");
127+	}
128+if(defined($_ = $self->{sock}->getc)) {
129+	return($_);
130+	}
131+die("EOF on socket");
132+}
133+
134+sub getlen($) {
135+my($self) = shift;
136+my($ch,$len);
137+
138+for(;;) {
139+	$ch = $self->getbyte;
140+	if($ch eq ':') {
141+		return($self->{len} = $len);
142+		}
143+	if($ch !~ /^\d$/) {
144+		die("Char '$ch' is not a number while determining length");
145+		}
146+	$len .= $ch;
147+	}
148+}
149+
150+sub getcomma($) {
151+my($self) = shift;
152+if($self->getbyte ne ',') {
153+	die("Comma expected, found '$_'");
154+	}
155+}
156+
157+sub getnetstring($$) {
158+my($self) = shift;
159+($self->{sock}->read($_[0],$self->getlen) == $self->{len}) ||
160+	die("EOF on socket");
161+$self->{bytesleft} -= $self->{len};
162+$self->getcomma;
163+}
164+
165+# Accept a QMQPqq connect
166+# and call content checking for the message received
167+#
168+sub process_qmqpqq_request($$$$) {
169+my($self,$sock,$conn,$check_mail) = @_;
170+# $sock:       connected socket from Net::Server
171+# $conn:       information about client connection
172+# $check_mail: subroutine ref to be called with file handle
173+
174+$self->{proto} = "QMQPqq";
175+$self->{session_closed_normally} = 0;	# closed properly?
176+$self->{sock} = $sock;		# store $sock info for getbyte() method
177+$self->{bytesleft} = 20;	# initial bytesleft value, there should
178+				# NEVER EVER be longer email than 10^20 (approximately)
179+				# bytes but increase if needed ;)
180+$self->{len} = undef;
181+
182+my($msginfo);
183+my($sender,@recips);
184+my($len);
185+
186+new_am_id(undef, $Amavis::child_invocation_count, undef);
187+Amavis::Timing::init();
188+
189+$conn->smtp_proto("QMQPqq");  # the name of the method is too specific
190+my($eval_stat);
191+eval {
192+	# get length of whole package
193+	$self->{bytesleft} = $self->getlen;
194+
195+	# get length of 'email'
196+	$len = $self->getlen;
197+	section_time('initial length determination');
198+
199+	# prepare tempdir
200+	Amavis::check_mail_begin_task();
201+	$self->{tempdir}->prepare;
202+	$self->{tempdir}->prepare_file;
203+
204+	$msginfo = Amavis::In::Message->new;
205+	$msginfo->rx_time(time);
206+	$msginfo->delivery_method(c('forward_method'));
207+
208+	# get 'email'
209+	$self->{tempdir}->empty(0);
210+	my $size = 16384;
211+	while(($len > 0) && ($sock->read($_,($len >= $size ? $size : $size = $len)) == $size)) {
212+		(print {$self->{tempdir}->fh} $_) ||
213+			die("Can't write to mail file: $!");
214+		$len -= $size;
215+		}
216+	if($len > 0) {
217+		die("EOF on socket");
218+		}
219+	$self->{tempdir}->fh->flush || die("Can't flush mail file: $!");
220+	$self->{tempdir}->fh->seek(0,1) || die("Can't seek on file: $!");
221+	$self->{bytesleft} -= $self->{len};
222+	section_time('email receiving');
223+	# comma has to follow
224+	$self->getcomma;
225+
226+	# get sender (presumably in unquoted form, really???)
227+	$self->getnetstring($sender);
228+	section_time('sender receiving');
229+
230+	# get recips (presumably in unquoted form, really???)
231+	my $i = 0;
232+	while($self->{bytesleft}) {
233+		$self->getnetstring($recips[$i++]);
234+		}
235+	section_time('recips receiving');
236+
237+	# final comma has to follow
238+	$self->{bytesleft} = 1;
239+	$self->getcomma;
240+
241+	$msginfo->sender($sender);
242+	$msginfo->sender_smtp(qquote_rfc2821_local($sender));
243+	$msginfo->recips(\@recips);
244+
245+	do_log(1, sprintf("%s:%s:%s %s: %s -> %s Received: %s",
246+		$self->{proto},$conn->socket_ip eq $inet_socket_bind ?
247+			'' : '['.$conn->socket_ip.']',
248+		$conn->socket_port, $self->{tempdir_pers},
249+		$msginfo->sender_smtp,
250+                join(',', map { $_->recip_addr_smtp }
251+                              @{$msginfo->per_recip_data}),
252+		join(' ',
253+			($msginfo->msg_size  eq '' ? ()
254+			: 'SIZE='.$msginfo->msg_size),
255+			($msginfo->body_type eq '' ? ()
256+			: 'BODY='.$msginfo->body_type),
257+			received_line($conn,$msginfo,am_id(),0) )
258+		));
259+
260+	$msginfo->mail_tempdir($self->{tempdir}->path);
261+	$msginfo->mail_text_fn($self->{tempdir}->path . '/email.txt');
262+	$msginfo->mail_text($self->{tempdir}->fh);
263+
264+	my($smtp_resp,$exit_code,$preserve_evidence) =
265+		&$check_mail($conn,$msginfo,0);
266+
267+	if ($preserve_evidence) { $self->{tempdir}->preserve(1) }
268+
269+	if ($smtp_resp !~ /^4/ &&
270+		grep { !$_->recip_done } @{$msginfo->per_recip_data}) {
271+		die("TROUBLE/MISCONFIG: not all recipients done, ".
272+			"\$forward_method is \"$forward_method\"");
273+		}
274+
275+	if ($smtp_resp !~ /^4/ &&
276+		grep { !$_->recip_done } @{$msginfo->per_recip_data}) {
277+		if ($msginfo->delivery_method eq '') {
278+			do_log(2,"not all recipients done, forward_method is empty");
279+			}
280+		else {
281+			die "TROUBLE: (MISCONFIG) not all recipients done, " .
282+			"forward_method is: " . $msginfo->delivery_method;
283+			}
284+		}
285+
286+	# all ok
287+	if($smtp_resp =~ /^2/) {
288+		$self->qmqpqq_resp("K",$smtp_resp);
289+		}
290+	# permanent reject
291+	elsif($smtp_resp =~ /^5/) {
292+		$self->qmqpqq_resp("D",$smtp_resp);
293+		}
294+	# temporary reject (or other error if !~ /^4/)
295+	else {
296+		$self->qmqpqq_resp("Z",$smtp_resp);
297+		}
298+	1;
299+} or do {
300+	$eval_stat = $@ ne '' ? $@ : "errno=$!";
301+};
302+
303+$self->{tempdir}->clean;
304+alarm(0); do_log(4,"timer stopped after QMQPqq eval");
305+
306+if($eval_stat ne '') {
307+	chomp $eval_stat;
308+	do_log(0,"QMQPqq: NOTICE: $eval_stat");
309+	$self->qmqpqq_resp("Z","Service shutting down, $eval_stat");
310+	}
311+# report elapsed times by section for each transaction
312+do_log(2, "%s", Amavis::Timing::report());
313+
314+$self->{session_closed_normally} = 1;
315+# closes connection after child_finish_hook
316+}
317+
318+# sends a QMQPqq response consisting of K/D/Z code and an optional message;
319+# slow down evil clients by delaying response on permanent errors
320+sub qmqpqq_resp($$$;$$) {
321+my($self,$code,$resp,$penalize,$line) = @_;
322+if($code !~ /^(K|Z|D)$/) {
323+	die("Internal error(2): bad QMQPqq response code: '$code'");
324+	}
325+if($penalize) {
326+	do_log(0,"QMQPqq: $resp; PENALIZE: $line");
327+	sleep 5;
328+	section_time('QMQPqq penalty wait');
329+	}
330+$resp = sanitize_str($resp,1);
331+do_log(4,"QMQPqq> $resp");
332+$self->{sock}->print($self->netstring($code . $resp));
333+}
334+
335+sub netstring($$) {
336+my($self,$string) = @_;
337+return(sprintf("%d:%s,",length($string),$string));
338+}
339+
340+1;
341+
342+__DATA__
343+#
344 package Amavis::Out::SMTP::Protocol;
345 use strict;
346--- amavisd.conf.ori	2017-12-27 19:25:28.006677000 +0100
347+++ amavisd.conf	2018-10-09 14:36:42.768450000 +0200
348@@ -56,6 +56,6 @@
349                # option(s) -p overrides $inet_socket_port and $unix_socketname
350
351-$inet_socket_port = 10024;   # listen on this local TCP port(s)
352-# $inet_socket_port = [10024,10026];  # listen on multiple TCP ports
353+$protocol = 'QMQPqq';        # suggested protocol to use on all input sockets
354+$inet_socket_port = 10628;   # accept connections on this local TCP port(s)
355
356 $policy_bank{'MYNETS'} = {   # mail originating from @mynetworks
357