[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};
}

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-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);
		if ($opts =~ m/\sSMTPUTF8/) {
		    $self->{smtputf8} = 1;
		    $from = decode('UTF-8', $from);
		}
		$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;
		push @{$self->{to}} , $to;
		$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");
		        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");
		    }
		}
	    }

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