[pmg-api.git] / src / PMG / SMTP.pm

package PMG::SMTP;

use strict;
use warnings;
use IO::Socket;
use Encode;
use MIME::Entity;

use PVE::SafeSyslog;

use PMG::MailQueue;
use PMG::Utils;

sub new {
    my($this, $sock) = @_;

    my $class = ref($this) || $this;

    die("undefined socket: ERROR") if !defined($sock);

    my $self = {};
    $self->{sock} = $sock;
    $self->{lmtp} = undef;
    bless($self, $class);

    $self->reset();

    $self->reply ("220 Proxmox SMTP Ready.");
    return $self;
}

sub reset {
    my $self = shift;

    $self->{from} = undef;
    $self->{to} = [];
    $self->{queue} = undef;
    delete $self->{smtputf8};
    delete $self->{xforward};
    delete $self->{status};
    delete $self->{param};
}

sub abort {
    shift->{sock}->close();
}

sub reply {
    print {shift->{sock}} @_, "\r\n";;

}

sub loop {
    my ($self, $func, $data, $maxcount) = @_;

    my($cmd, $args);

    my $sock = $self->{sock};

    my $count = 0;

    while(<$sock>) {
	chomp;
	s/^\s+//;
	s/\s+$//;

	if (!length ($_)) {
	    $self->reply ("500 5.5.1 Error: bad syntax");
	    next;
	}
	($cmd, $args) = split(/\s+/, $_, 2);
	$cmd = lc ($cmd);

	if ($cmd eq 'helo' || $cmd eq 'ehlo' || $cmd eq 'lhlo') {
	    $self->reset();

	    $self->reply ("250-PIPELINING");
	    $self->reply ("250-ENHANCEDSTATUSCODES");
	    $self->reply ("250-8BITMIME");
	    $self->reply ("250-SMTPUTF8");
	    $self->reply ("250-DSN");
	    $self->reply ("250-XFORWARD NAME ADDR PROTO HELO");
	    $self->reply ("250 OK.");
	    $self->{lmtp} = 1 if ($cmd eq 'lhlo');
	    next;
	} elsif ($cmd eq 'xforward') {
	    my @tmp = split (/\s+/, $args);
	    foreach my $attr (@tmp) {
		my ($n, $v) = ($attr =~ /^(.*?)=(.*)$/);
		$self->{xforward}->{lc($n)} = $v;
	    }
	    $self->reply ("250 2.5.0 OK");
	    next;
	} elsif ($cmd eq 'noop') {
	    $self->reply ("250 2.5.0 OK");
	    next;
	} elsif ($cmd eq 'quit') {
	    $self->reply ("221 2.2.0 OK");
	    last;
	} elsif ($cmd eq 'rset') {
	    $self->reset();
	    $self->reply ("250 2.5.0 OK");
	    next;
	} elsif ($cmd eq 'mail') {
	    if ($args =~ m/^from:\s*<([^\s\>]*?)>( .*)?$/i) {
		delete $self->{to};
		my ($from, $opts) = ($1, $2 // '');

		for my $opt (split(' ', $opts)) {
		    if ($opt =~ /(ret|envid)=([^ =]+)/i ) {
			$self->{param}->{mail}->{$1} = $2;
		    } elsif ($opt =~ m/smtputf8/i) {
			$self->{smtputf8} = 1;
			$self->{param}->{mail}->{smtputf8} = 1;
			$from = decode('UTF-8', $from);
		    } else {
			#ignore everything else
		    }
		}
		$self->{from} = $from;
		$self->reply ('250 2.5.0 OK');
		next;
	    } else {
		$self->reply ("501 5.5.2 Syntax: MAIL FROM: <address>");
		next;
	    }
	} elsif ($cmd eq 'rcpt') {
	    if ($args =~ m/^to:\s*<([^\s\>]+?)>( .*)?$/i) {
		my $to = $self->{smtputf8} ? decode('UTF-8', $1) : $1;
		my $opts = $2 // '';
		push @{$self->{to}} , $to;
		for my $opt (split(' ', $opts)) {
		    if ($opt =~ /(notify|orcpt)=([^ =]+)/i ) {
			$self->{param}->{rcpt}->{$to}->{$1} = $2;
		    } else {
			#ignore everything else
		    }
		}
		$self->reply ('250 2.5.0 OK');
		next;
	    } else {
		$self->reply ("501 5.5.2 Syntax: RCPT TO: <address>");
		next;
	    }
	} elsif ($cmd eq 'data') {
	    if ($self->save_data ()) {
		eval { &$func ($data, $self); };
		if (my $err = $@) {
		    $data->{errors} = 1;
		    syslog ('err', $err);
		}

		my $cfg = $data->{pmg_cfg};

		if ($self->{lmtp}) {
		    foreach $a (@{$self->{to}}) {
			if ($self->{queue}->{status}->{$a} eq 'delivered') {
			    $self->reply ("250 2.5.0 OK ($self->{queue}->{logid})");
			} elsif ($self->{queue}->{status}->{$a} eq 'blocked') {
			    if ($cfg->get('mail', 'ndr_on_block')) {
				$self->reply ("554 5.7.1 Rejected for policy reasons ($self->{queue}->{logid})");
			    } else {
				$self->reply ("250 2.7.0 BLOCKED ($self->{queue}->{logid})");
			    }
			} elsif ($self->{queue}->{status}->{$a} eq 'error') {
			    my $code = $self->{queue}->{status_code}->{$a};
			    my $resp = substr($code, 0, 1);
			    my $mess = $self->{queue}->{status_message}->{$a};
			    $self->reply ("$code $resp.0.0 $mess");
			} else {
			    $self->reply ("451 4.4.0 detected undelivered mail to <$a>");
			}
		    }
		} else {
		    my $queueid = $self->{queue}->{logid};
		    my $qstat = $self->{queue}->{status};
		    my @rec = keys %$qstat;
		    my @success_rec = grep { $qstat->{$_} eq 'delivered' } @rec;
		    my @reject_rec = grep { $qstat->{$_} eq 'blocked' } @rec;

		    if (scalar(@reject_rec) == scalar(@rec)) {
			$self->reply ("554 5.7.1 Rejected for policy reasons ($queueid)");
		        syslog('info', "reject mail $queueid");
		    } elsif ((scalar(@reject_rec) + scalar(@success_rec)) == scalar(@rec)) {
			$self->reply ("250 2.5.0 OK ($queueid)");
			if ($cfg->get('mail', 'ndr_on_block')) {
			    my $dnsinfo = $cfg->get_host_dns_info();
			    generate_ndr($self->{from}, [ @reject_rec ], $dnsinfo->{fqdn}, $queueid) if scalar(@reject_rec);
			}
		    } else {
			$self->reply ("451 4.4.0 detected undelivered mail ($queueid)");
		    }
		}
	    }

	    $self->reset();

	    $count++;
	    last if $count >= $maxcount;
	    last if $data->{errors}; # abort if we find errors
	    next;
	}

	$self->reply ("500 5.5.1 Error: unknown command");
    }

    $self->{sock}->close;
    return $count;
}

sub save_data {
    my $self = shift;
    my $done = undef;

    if(!defined($self->{from})) {
	$self->reply ("503 5.5.1 Tell me who you are.");
	return 0;
    }

    if(!defined($self->{to})) {
	$self->reply ("503 5.5.1 Tell me who to send it.");
	return 0;
    }

    $self->reply ("354 End data with <CR><LF>.<CR><LF>");

    my $sock = $self->{sock};

    my $queue;

    eval {
	$queue = PMG::MailQueue->new ($self->{from}, $self->{to});

	while(<$sock>) {

	    if(/^\.\015\012$/) {
		$done = 1;
		last;
	    }

	    # RFC 2821 compliance.
	    s/^\.\./\./;

	    s/\015\012/\n/;

	    print {$queue->{fh}} $_;
	    $queue->{bytes} += length ($_);
	}

	$queue->{fh}->flush ();

	$self->{queue} = $queue;
    };
    if (my $err = $@) {
	syslog ('err', $err);
	$self->reply ("451 4.5.0 Local delivery failed: $err");
	return 0;
    }
    if(!defined($done)) {
	$self->reply ("451 4.5.0 Local delivery failed: unfinished data");
	return 0;
    }

    return 1;
}

sub generate_ndr {
    my ($sender, $receivers, $hostname, $queueid) = @_;

    my $ndr_text = <<EOF
This is the mail system at host $hostname.

I'm sorry to have to inform you that your message could not
be delivered to one or more recipients.

For further assistance, please send mail to postmaster.

If you do so, please include this problem report.
                   The mail system

554 5.7.1 Recipient address(es) rejected for policy reasons
EOF
;
    my $ndr = MIME::Entity->build(
	Type => 'multipart/report; report-type=delivery-status;',
	To => $sender,
	From => 'postmaster',
	Subject => 'Undelivered Mail');

    $ndr->attach(
	Data => $ndr_text,
	Type => 'text/plain; charset=utf-8',
	Encoding => '8bit');

    my $delivery_status = <<EOF
Reporting-MTA: dns; $hostname
X-Proxmox-Queue-ID: $queueid
X-Proxmox-Sender: rfc822; $sender
EOF
;
    foreach my $rec (@$receivers) {
	$delivery_status .= <<EOF
Final-Recipient: rfc822; $rec
Original-Recipient: rfc822;$rec
Action: failed
Status: 5.7.1
Diagnostic-Code: smtp; 554 5.7.1 Recipient address rejected for policy reasons

EOF
;
    }
    $ndr->attach(
	Data => $delivery_status,
	Type => 'message/delivery-status',
	Encoding => '7bit',
	Description => 'Delivery report');

    my $qid = PMG::Utils::reinject_local_mail($ndr, '', [$sender], undef, $hostname);
    if ($qid) {
	syslog('info', "sent NDR for rejecting recipients - $qid");
    } else {
	syslog('err', "sending NDR for rejecting recipients failed");
    }
}

1;
Commit	Line	Data
14726412	1	package PMG::SMTP;
73238bb3 DM	2
73238bb3 DM	3	use strict;
14726412	4	use warnings;
73238bb3	5	use IO::Socket;
00eaaf69	6	use Encode;
cebfe036	7	use MIME::Entity;
73238bb3	8
14726412 DM	9	use PVE::SafeSyslog;
	10
	11	use PMG::MailQueue;
cebfe036	12	use PMG::Utils;
14726412	13
73238bb3 DM	14	sub new {
73238bb3 DM	15	my($this, $sock) = @_;
14726412	16
73238bb3 DM	17	my $class = ref($this) \|\| $this;
73238bb3 DM	18
9ef3f143	19	die("undefined socket: ERROR") if !defined($sock);
73238bb3 DM	20
	21	my $self = {};
	22	$self->{sock} = $sock;
	23	$self->{lmtp} = undef;
	24	bless($self, $class);
	25
	26	$self->reset();
	27
	28	$self->reply ("220 Proxmox SMTP Ready.");
	29	return $self;
	30	}
	31
	32	sub reset {
	33	my $self = shift;
	34
	35	$self->{from} = undef;
	36	$self->{to} = [];
	37	$self->{queue} = undef;
4a00e01d	38	delete $self->{smtputf8};
73238bb3 DM	39	delete $self->{xforward};
73238bb3 DM	40	delete $self->{status};
ad1c6bce	41	delete $self->{param};
73238bb3 DM	42	}
	43
	44	sub abort {
	45	shift->{sock}->close();
	46	}
	47
	48	sub reply {
	49	print {shift->{sock}} @_, "\r\n";;
	50
	51	}
	52
	53	sub loop {
	54	my ($self, $func, $data, $maxcount) = @_;
	55
	56	my($cmd, $args);
73238bb3	57
14726412	58	my $sock = $self->{sock};
73238bb3 DM	59
	60	my $count = 0;
	61
	62	while(<$sock>) {
	63	chomp;
	64	s/^\s+//;
	65	s/\s+$//;
	66
	67	if (!length ($_)) {
	68	$self->reply ("500 5.5.1 Error: bad syntax");
	69	next;
	70	}
	71	($cmd, $args) = split(/\s+/, $_, 2);
	72	$cmd = lc ($cmd);
	73
	74	if ($cmd eq 'helo' \|\| $cmd eq 'ehlo' \|\| $cmd eq 'lhlo') {
	75	$self->reset();
	76
73238bb3 DM	77	$self->reply ("250-PIPELINING");
	78	$self->reply ("250-ENHANCEDSTATUSCODES");
	79	$self->reply ("250-8BITMIME");
00eaaf69	80	$self->reply ("250-SMTPUTF8");
ad1c6bce	81	$self->reply ("250-DSN");
73238bb3 DM	82	$self->reply ("250-XFORWARD NAME ADDR PROTO HELO");
	83	$self->reply ("250 OK.");
	84	$self->{lmtp} = 1 if ($cmd eq 'lhlo');
	85	next;
	86	} elsif ($cmd eq 'xforward') {
	87	my @tmp = split (/\s+/, $args);
	88	foreach my $attr (@tmp) {
	89	my ($n, $v) = ($attr =~ /^(.?)=(.)$/);
	90	$self->{xforward}->{lc($n)} = $v;
	91	}
	92	$self->reply ("250 2.5.0 OK");
	93	next;
	94	} elsif ($cmd eq 'noop') {
	95	$self->reply ("250 2.5.0 OK");
	96	next;
	97	} elsif ($cmd eq 'quit') {
	98	$self->reply ("221 2.2.0 OK");
	99	last;
	100	} elsif ($cmd eq 'rset') {
	101	$self->reset();
	102	$self->reply ("250 2.5.0 OK");
	103	next;
	104	} elsif ($cmd eq 'mail') {
89b8996d	105	if ($args =~ m/^from:\s<([^\s\>]?)>( .*)?$/i) {
73238bb3	106	delete $self->{to};
89b8996d	107	my ($from, $opts) = ($1, $2 // '');
ad1c6bce SI	108
	109	for my $opt (split(' ', $opts)) {
	110	if ($opt =~ /(ret\|envid)=([^ =]+)/i ) {
	111	$self->{param}->{mail}->{$1} = $2;
	112	} elsif ($opt =~ m/smtputf8/i) {
	113	$self->{smtputf8} = 1;
a56a4b54	114	$self->{param}->{mail}->{smtputf8} = 1;
ad1c6bce SI	115	$from = decode('UTF-8', $from);
	116	} else {
	117	#ignore everything else
	118	}
4a00e01d	119	}
00eaaf69	120	$self->{from} = $from;
73238bb3 DM	121	$self->reply ('250 2.5.0 OK');
	122	next;
	123	} else {
	124	$self->reply ("501 5.5.2 Syntax: MAIL FROM: <address>");
	125	next;
	126	}
	127	} elsif ($cmd eq 'rcpt') {
89b8996d	128	if ($args =~ m/^to:\s<([^\s\>]+?)>( .)?$/i) {
4a00e01d	129	my $to = $self->{smtputf8} ? decode('UTF-8', $1) : $1;
ad1c6bce	130	my $opts = $2 // '';
4a00e01d	131	push @{$self->{to}} , $to;
ad1c6bce SI	132	for my $opt (split(' ', $opts)) {
	133	if ($opt =~ /(notify\|orcpt)=([^ =]+)/i ) {
	134	$self->{param}->{rcpt}->{$to}->{$1} = $2;
	135	} else {
	136	#ignore everything else
	137	}
	138	}
73238bb3 DM	139	$self->reply ('250 2.5.0 OK');
	140	next;
	141	} else {
f6c789ba	142	$self->reply ("501 5.5.2 Syntax: RCPT TO: <address>");
73238bb3 DM	143	next;
	144	}
	145	} elsif ($cmd eq 'data') {
	146	if ($self->save_data ()) {
	147	eval { &$func ($data, $self); };
9d04575a	148	if (my $err = $@) {
73238bb3	149	$data->{errors} = 1;
9d04575a	150	syslog ('err', $err);
73238bb3 DM	151	}
73238bb3 DM	152
88a51503 SI	153	my $cfg = $data->{pmg_cfg};
88a51503 SI	154
73238bb3 DM	155	if ($self->{lmtp}) {
	156	foreach $a (@{$self->{to}}) {
	157	if ($self->{queue}->{status}->{$a} eq 'delivered') {
	158	$self->reply ("250 2.5.0 OK ($self->{queue}->{logid})");
	159	} elsif ($self->{queue}->{status}->{$a} eq 'blocked') {
88a51503 SI	160	if ($cfg->get('mail', 'ndr_on_block')) {
	161	$self->reply ("554 5.7.1 Rejected for policy reasons ($self->{queue}->{logid})");
	162	} else {
	163	$self->reply ("250 2.7.0 BLOCKED ($self->{queue}->{logid})");
	164	}
73238bb3 DM	165	} elsif ($self->{queue}->{status}->{$a} eq 'error') {
	166	my $code = $self->{queue}->{status_code}->{$a};
	167	my $resp = substr($code, 0, 1);
	168	my $mess = $self->{queue}->{status_message}->{$a};
	169	$self->reply ("$code $resp.0.0 $mess");
	170	} else {
	171	$self->reply ("451 4.4.0 detected undelivered mail to <$a>");
	172	}
	173	}
	174	} else {
e0cbdf9f SI	175	my $queueid = $self->{queue}->{logid};
	176	my $qstat = $self->{queue}->{status};
	177	my @rec = keys %$qstat;
	178	my @success_rec = grep { $qstat->{$_} eq 'delivered' } @rec;
	179	my @reject_rec = grep { $qstat->{$_} eq 'blocked' } @rec;
	180
	181	if (scalar(@reject_rec) == scalar(@rec)) {
5eaba42b	182	$self->reply ("554 5.7.1 Rejected for policy reasons ($queueid)");
e0cbdf9f SI	183	syslog('info', "reject mail $queueid");
	184	} elsif ((scalar(@reject_rec) + scalar(@success_rec)) == scalar(@rec)) {
	185	$self->reply ("250 2.5.0 OK ($queueid)");
	186	if ($cfg->get('mail', 'ndr_on_block')) {
	187	my $dnsinfo = $cfg->get_host_dns_info();
	188	generate_ndr($self->{from}, [ @reject_rec ], $dnsinfo->{fqdn}, $queueid) if scalar(@reject_rec);
73238bb3	189	}
73238bb3	190	} else {
5eaba42b	191	$self->reply ("451 4.4.0 detected undelivered mail ($queueid)");
73238bb3 DM	192	}
	193	}
	194	}
	195
	196	$self->reset();
	197
	198	$count++;
	199	last if $count >= $maxcount;
	200	last if $data->{errors}; # abort if we find errors
	201	next;
	202	}
14726412	203
73238bb3 DM	204	$self->reply ("500 5.5.1 Error: unknown command");
	205	}
	206
	207	$self->{sock}->close;
	208	return $count;
	209	}
	210
	211	sub save_data {
	212	my $self = shift;
	213	my $done = undef;
14726412	214
73238bb3 DM	215	if(!defined($self->{from})) {
	216	$self->reply ("503 5.5.1 Tell me who you are.");
	217	return 0;
	218	}
14726412	219
73238bb3 DM	220	if(!defined($self->{to})) {
	221	$self->reply ("503 5.5.1 Tell me who to send it.");
	222	return 0;
	223	}
	224
	225	$self->reply ("354 End data with <CR><LF>.<CR><LF>");
	226
	227	my $sock = $self->{sock};
	228
	229	my $queue;
	230
	231	eval {
14726412 DM	232	$queue = PMG::MailQueue->new ($self->{from}, $self->{to});
14726412 DM	233
73238bb3 DM	234	while(<$sock>) {
	235
	236	if(/^\.\015\012$/) {
	237	$done = 1;
	238	last;
	239	}
14726412	240
73238bb3 DM	241	# RFC 2821 compliance.
	242	s/^\.\./\./;
	243
14726412	244	s/\015\012/\n/;
73238bb3 DM	245
	246	print {$queue->{fh}} $_;
	247	$queue->{bytes} += length ($_);
	248	}
	249
	250	$queue->{fh}->flush ();
	251
14726412	252	$self->{queue} = $queue;
73238bb3	253	};
9d04575a DM	254	if (my $err = $@) {
	255	syslog ('err', $err);
	256	$self->reply ("451 4.5.0 Local delivery failed: $err");
73238bb3 DM	257	return 0;
	258	}
	259	if(!defined($done)) {
	260	$self->reply ("451 4.5.0 Local delivery failed: unfinished data");
	261	return 0;
	262	}
	263
	264	return 1;
	265	}
	266
cebfe036 SI	267	sub generate_ndr {
	268	my ($sender, $receivers, $hostname, $queueid) = @_;
	269
	270	my $ndr_text = <<EOF
	271	This is the mail system at host $hostname.
	272
	273	I'm sorry to have to inform you that your message could not
	274	be delivered to one or more recipients.
	275
	276	For further assistance, please send mail to postmaster.
	277
	278	If you do so, please include this problem report.
	279	The mail system
	280
	281	554 5.7.1 Recipient address(es) rejected for policy reasons
	282	EOF
	283	;
	284	my $ndr = MIME::Entity->build(
	285	Type => 'multipart/report; report-type=delivery-status;',
	286	To => $sender,
	287	From => 'postmaster',
	288	Subject => 'Undelivered Mail');
	289
	290	$ndr->attach(
	291	Data => $ndr_text,
	292	Type => 'text/plain; charset=utf-8',
	293	Encoding => '8bit');
	294
	295	my $delivery_status = <<EOF
	296	Reporting-MTA: dns; $hostname
	297	X-Proxmox-Queue-ID: $queueid
	298	X-Proxmox-Sender: rfc822; $sender
	299	EOF
	300	;
	301	foreach my $rec (@$receivers) {
	302	$delivery_status .= <<EOF
	303	Final-Recipient: rfc822; $rec
	304	Original-Recipient: rfc822;$rec
	305	Action: failed
	306	Status: 5.7.1
	307	Diagnostic-Code: smtp; 554 5.7.1 Recipient address rejected for policy reasons
	308
	309	EOF
	310	;
	311	}
	312	$ndr->attach(
	313	Data => $delivery_status,
	314	Type => 'message/delivery-status',
	315	Encoding => '7bit',
	316	Description => 'Delivery report');
	317
a56a4b54	318	my $qid = PMG::Utils::reinject_local_mail($ndr, '', [$sender], undef, $hostname);
cebfe036 SI	319	if ($qid) {
	320	syslog('info', "sent NDR for rejecting recipients - $qid");
	321	} else {
	322	syslog('err', "sending NDR for rejecting recipients failed");
	323	}
	324	}
	325
73238bb3	326	1;