src/PMG/SMTP.pm

   1 package PMG::SMTP;
   2
   3 use strict;
   4 use warnings;
   5 use IO::Socket;
   6 use Encode;
   7 use MIME::Entity;
   8
   9 use PVE::SafeSyslog;
  10
  11 use PMG::MailQueue;
  12 use PMG::Utils;
  13
  14 sub new {
  15     my($this, $sock) = @_;
  16
  17     my $class = ref($this) || $this;
  18
  19     die("undefined socket: ERROR") if !defined($sock);
  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;
  38     delete $self->{smtputf8};
  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);
  56
  57     my $sock = $self->{sock};
  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
  76             $self->reply ("250-PIPELINING");
  77             $self->reply ("250-ENHANCEDSTATUSCODES");
  78             $self->reply ("250-8BITMIME");
  79             $self->reply ("250-SMTPUTF8");
  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') {
 103             if ($args =~ m/^from:\s*<([^\s\>]*)>([^>]*)$/i) {
 104                 delete $self->{to};
 105                 my ($from, $opts) = ($1, $2);
 106                 if ($opts =~ m/\sSMTPUTF8/) {
 107                     $self->{smtputf8} = 1;
 108                     $from = decode('UTF-8', $from);
 109                 }
 110                 $self->{from} = $from;
 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') {
 118             if ($args =~ m/^to:\s*<([^\s\>]+)>[^>]*$/i) {
 119                 my $to = $self->{smtputf8} ? decode('UTF-8', $1) : $1;
 120                 push @{$self->{to}} , $to;
 121                 $self->reply ('250 2.5.0 OK');
 122                 next;
 123             } else {
 124                 $self->reply ("501 5.5.2 Syntax: RCPT TO: <address>");
 125                 next;
 126             }
 127         } elsif ($cmd eq 'data') {
 128             if ($self->save_data ()) {
 129                 eval { &$func ($data, $self); };
 130                 if (my $err = $@) {
 131                     $data->{errors} = 1;
 132                     syslog ('err', $err);
 133                 }
 134
 135                 my $cfg = $data->{pmg_cfg};
 136
 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') {
 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                             }
 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 {
 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 ($queueid)");
 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);
 171                         }
 172                     } else {
 173                         $self->reply ("451 4.4.0 detected undelivered mail ($queueid)");
 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         }
 185
 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;
 196
 197     if(!defined($self->{from})) {
 198         $self->reply ("503 5.5.1 Tell me who you are.");
 199         return 0;
 200     }
 201
 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 {
 214         $queue = PMG::MailQueue->new ($self->{from}, $self->{to});
 215
 216         while(<$sock>) {
 217
 218             if(/^\.\015\012$/) {
 219                 $done = 1;
 220                 last;
 221             }
 222
 223             # RFC 2821 compliance.
 224             s/^\.\./\./;
 225
 226             s/\015\012/\n/;
 227
 228             print {$queue->{fh}} $_;
 229             $queue->{bytes} += length ($_);
 230         }
 231
 232         $queue->{fh}->flush ();
 233
 234         $self->{queue} = $queue;
 235     };
 236     if (my $err = $@) {
 237         syslog ('err', $err);
 238         $self->reply ("451 4.5.0 Local delivery failed: $err");
 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
 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
 308 1;