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     delete $self->{param};
  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);
  57
  58     my $sock = $self->{sock};
  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
  77             $self->reply ("250-PIPELINING");
  78             $self->reply ("250-ENHANCEDSTATUSCODES");
  79             $self->reply ("250-8BITMIME");
  80             $self->reply ("250-SMTPUTF8");
  81             $self->reply ("250-DSN");
  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') {
 105             if ($args =~ m/^from:\s*<([^\s\>]*?)>( .*)?$/i) {
 106                 delete $self->{to};
 107                 my ($from, $opts) = ($1, $2 // '');
 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;
 114                         $self->{param}->{mail}->{smtputf8} = 1;
 115                         $from = decode('UTF-8', $from);
 116                     } else {
 117                         #ignore everything else
 118                     }
 119                 }
 120                 $self->{from} = $from;
 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') {
 128             if ($args =~ m/^to:\s*<([^\s\>]+?)>( .*)?$/i) {
 129                 my $to = $self->{smtputf8} ? decode('UTF-8', $1) : $1;
 130                 my $opts = $2 // '';
 131                 push @{$self->{to}} , $to;
 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                 }
 139                 $self->reply ('250 2.5.0 OK');
 140                 next;
 141             } else {
 142                 $self->reply ("501 5.5.2 Syntax: RCPT TO: <address>");
 143                 next;
 144             }
 145         } elsif ($cmd eq 'data') {
 146             if ($self->save_data ()) {
 147                 eval { &$func ($data, $self); };
 148                 if (my $err = $@) {
 149                     $data->{errors} = 1;
 150                     syslog ('err', $err);
 151                 }
 152
 153                 my $cfg = $data->{pmg_cfg};
 154
 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') {
 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                             }
 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 {
 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)) {
 182                         $self->reply ("554 5.7.1 Rejected for policy reasons ($queueid)");
 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);
 189                         }
 190                     } else {
 191                         $self->reply ("451 4.4.0 detected undelivered mail ($queueid)");
 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         }
 203
 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;
 214
 215     if(!defined($self->{from})) {
 216         $self->reply ("503 5.5.1 Tell me who you are.");
 217         return 0;
 218     }
 219
 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 {
 232         $queue = PMG::MailQueue->new ($self->{from}, $self->{to});
 233
 234         while(<$sock>) {
 235
 236             if(/^\.\015\012$/) {
 237                 $done = 1;
 238                 last;
 239             }
 240
 241             # RFC 2821 compliance.
 242             s/^\.\./\./;
 243
 244             s/\015\012/\n/;
 245
 246             print {$queue->{fh}} $_;
 247             $queue->{bytes} += length ($_);
 248         }
 249
 250         $queue->{fh}->flush ();
 251
 252         $self->{queue} = $queue;
 253     };
 254     if (my $err = $@) {
 255         syslog ('err', $err);
 256         $self->reply ("451 4.5.0 Local delivery failed: $err");
 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
 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
 318     my $qid = PMG::Utils::reinject_local_mail($ndr, '', [$sender], undef, $hostname);
 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
 326 1;