1package Sisimai::Lhost::X4;
2use parent 'Sisimai::Lhost';
3use feature ':5.10';
4use strict;
5use warnings;
6
7sub description { 'Unknown MTA #4 qmail clones' }
8sub make {
9    # Detect an error from Unknown MTA #4, qmail clones
10    # @param    [Hash] mhead    Message headers of a bounce email
11    # @param    [String] mbody  Message body of a bounce email
12    # @return   [Hash]          Bounce data list and message/rfc822 part
13    # @return   [Undef]         failed to parse or the arguments are missing
14    # @since v4.1.23
15    my $class = shift;
16    my $mhead = shift // return undef;
17    my $mbody = shift // return undef;
18    my $match = 0;
19    my $tryto = qr/\A[(]qmail[ ]+\d+[ ]+invoked[ ]+for[ ]+bounce[)]/;
20
21    # Pre process email headers and the body part of the message which generated
22    # by qmail, see https://cr.yp.to/qmail.html
23    #   e.g.) Received: (qmail 12345 invoked for bounce); 29 Apr 2009 12:34:56 -0000
24    #         Subject: failure notice
25    $match ||= 1 if index($mhead->{'subject'}, 'failure notice') == 0;
26    $match ||= 1 if index($mhead->{'subject'}, 'Permanent Delivery Failure') == 0;
27    $match ||= 1 if grep { $_ =~ $tryto } @{ $mhead->{'received'} };
28    return undef unless $match;
29
30    state $indicators = __PACKAGE__->INDICATORS;
31    state $rebackbone = qr/^---[ ](?:Below this line is a copy of the message|Original message follows)[.]/m;
32    state $startingof = { 'error'  => ['Remote host said:'] };
33    state $markingsof = {
34        #  qmail-remote.c:248|    if (code >= 500) {
35        #  qmail-remote.c:249|      out("h"); outhost(); out(" does not like recipient.\n");
36        #  qmail-remote.c:265|  if (code >= 500) quit("D"," failed on DATA command");
37        #  qmail-remote.c:271|  if (code >= 500) quit("D"," failed after I sent the message");
38        #
39        # Characters: K,Z,D in qmail-qmqpc.c, qmail-send.c, qmail-rspawn.c
40        #  K = success, Z = temporary error, D = permanent error
41        #
42        # MTA module for qmail clones
43        'message' => qr{\A(?>
44             He/Her[ ]is[ ]not[ ].+[ ]user
45            |Hi[.][ ].+[ ]unable[ ]to[ ]deliver[ ]your[ ]message[ ]to[ ]the[ ]following[ ]addresses
46            |Su[ ]mensaje[ ]no[ ]pudo[ ]ser[ ]entregado
47            |This[ ]is[ ]the[ ](?:
48                 machine[ ]generated[ ]message[ ]from[ ]mail[ ]service
49                |mail[ ]delivery[ ]agent[ ]at
50                )
51            |Unable[ ]to[ ]deliver[ ]message[ ]to[ ]the[ ]following[ ]address
52            |Unfortunately,[ ]your[ ]mail[ ]was[ ]not[ ]delivered[ ]to[ ]the[ ]following[ ]address:
53            |Your[ ](?:
54                 mail[ ]message[ ]to[ ]the[ ]following[ ]address
55                |message[ ]to[ ]the[ ]following[ ]addresses
56                )
57            |We're[ ]sorry[.]
58            )
59        }x,
60    };
61
62    state $resmtp = {
63        # Error text regular expressions which defined in qmail-remote.c
64        # qmail-remote.c:225|  if (smtpcode() != 220) quit("ZConnected to "," but greeting failed");
65        'conn' => qr/(?:Error:)?Connected to [^ ]+ but greeting failed[.]/,
66        # qmail-remote.c:231|  if (smtpcode() != 250) quit("ZConnected to "," but my name was rejected");
67        'ehlo' => qr/(?:Error:)?Connected to [^ ]+ but my name was rejected[.]/,
68        # qmail-remote.c:238|  if (code >= 500) quit("DConnected to "," but sender was rejected");
69        # reason = rejected
70        'mail' => qr/(?:Error:)?Connected to [^ ]+ but sender was rejected[.]/,
71        # qmail-remote.c:249|  out("h"); outhost(); out(" does not like recipient.\n");
72        # qmail-remote.c:253|  out("s"); outhost(); out(" does not like recipient.\n");
73        # reason = userunknown
74        'rcpt' => qr/(?:Error:)?[^ ]+ does not like recipient[.]/,
75        # qmail-remote.c:265|  if (code >= 500) quit("D"," failed on DATA command");
76        # qmail-remote.c:266|  if (code >= 400) quit("Z"," failed on DATA command");
77        # qmail-remote.c:271|  if (code >= 500) quit("D"," failed after I sent the message");
78        # qmail-remote.c:272|  if (code >= 400) quit("Z"," failed after I sent the message");
79        'data' => qr{(?:
80             (?:Error:)?[^ ]+[ ]failed[ ]on[ ]DATA[ ]command[.]
81            |(?:Error:)?[^ ]+[ ]failed[ ]after[ ]I[ ]sent[ ]the[ ]message[.]
82            )
83        }x,
84    };
85    state $rehost = qr{(?:
86        # qmail-remote.c:261|  if (!flagbother) quit("DGiving up on ","");
87         Giving[ ]up[ ]on[ ]([^ ]+[0-9a-zA-Z])[.]?\z
88        |Connected[ ]to[ ]([-0-9a-zA-Z.]+[0-9a-zA-Z])[ ]
89        |remote[ ]host[ ]([-0-9a-zA-Z.]+[0-9a-zA-Z])[ ]said:
90        )
91    }x;
92
93    # qmail-send.c:922| ... (&dline[c],"I'm not going to try again; this message has been in the queue too long.\n")) nomem();
94    state $hasexpired = 'this message has been in the queue too long.';
95    # qmail-remote-fallback.patch
96    state $recommands = qr/Sorry,[ ]no[ ]SMTP[ ]connection[ ]got[ ]far[ ]enough;[ ]most[ ]progress[ ]was[ ]([A-Z]{4})[ ]/x;
97    state $reisonhold = qr/\A[^ ]+ does not like recipient[.][ \t]+.+this message has been in the queue too long[.]\z/;
98    state $failonldap = {
99        # qmail-ldap-1.03-20040101.patch:19817 - 19866
100        'suspend'     => ['Mailaddress is administrative?le?y disabled'],   # 5.2.1
101        'userunknown' => ['Sorry, no mailbox here by that name'],           # 5.1.1
102        'exceedlimit' => ['The message exeeded the maximum size the user accepts'], # 5.2.3
103        'systemerror' => [
104            'Automatic homedir creator crashed',    # 4.3.0
105            'Illegal value in LDAP attribute',      # 5.3.5
106            'LDAP attribute is not given but mandatory',        # 5.3.5
107            'Timeout while performing search on LDAP server',   # 4.4.3
108            'Too many results returned but needs to be unique', # 5.3.5
109            'Permanent error while executing qmail-forward',    # 5.4.4
110            'Temporary error in automatic homedir creation',    # 4.3.0 or 5.3.0
111            'Temporary error while executing qmail-forward',    # 4.4.4
112            'Temporary failure in LDAP lookup',                 # 4.4.3
113            'Unable to contact LDAP server',                    # 4.4.3
114            'Unable to login into LDAP server, bad credentials',# 4.4.3
115        ],
116    };
117    state $messagesof = {
118        # qmail-local.c:589|  strerr_die1x(100,"Sorry, no mailbox here by that name. (#5.1.1)");
119        # qmail-remote.c:253|  out("s"); outhost(); out(" does not like recipient.\n");
120        'userunknown' => [
121            'no mailbox here by that name',
122            'does not like recipient.',
123        ],
124        # error_str.c:192|  X(EDQUOT,"disk quota exceeded")
125        'mailboxfull' => ['disk quota exceeded'],
126        # qmail-qmtpd.c:233| ... result = "Dsorry, that message size exceeds my databytes limit (#5.3.4)";
127        # qmail-smtpd.c:391| ... out("552 sorry, that message size exceeds my databytes limit (#5.3.4)\r\n"); return;
128        'mesgtoobig'  => ['Message size exceeds fixed maximum message size:'],
129        # qmail-remote.c:68|  Sorry, I couldn't find any host by that name. (#4.1.2)\n"); zerodie();
130        # qmail-remote.c:78|  Sorry, I couldn't find any host named ");
131        'hostunknown' => ["Sorry, I couldn't find any host "],
132        'systemfull'  => ['Requested action not taken: mailbox unavailable (not enough free space)'],
133        'systemerror' => [
134            'bad interpreter: No such file or directory',
135            'system error',
136            'Unable to',
137        ],
138        'networkerror'=> [
139            "Sorry, I wasn't able to establish an SMTP connection",
140            "Sorry, I couldn't find a mail exchanger or IP address",
141            "Sorry. Although I'm listed as a best-preference MX or A for that host",
142        ],
143    };
144
145    my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
146    my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
147    my $readcursor = 0;     # (Integer) Points the current cursor position
148    my $recipients = 0;     # (Integer) The number of 'Final-Recipient' header
149    my $v = undef;
150
151    for my $e ( split("\n", $emailsteak->[0]) ) {
152        # Read error messages and delivery status lines from the head of the email
153        # to the previous line of the beginning of the original message.
154        unless( $readcursor ) {
155            # Beginning of the bounce message or message/delivery-status part
156            $readcursor |= $indicators->{'deliverystatus'} if $e =~ $markingsof->{'message'};
157            next;
158        }
159        next unless $readcursor & $indicators->{'deliverystatus'};
160        next unless length $e;
161
162        # <kijitora@example.jp>:
163        # 192.0.2.153 does not like recipient.
164        # Remote host said: 550 5.1.1 <kijitora@example.jp>... User Unknown
165        # Giving up on 192.0.2.153.
166        $v = $dscontents->[-1];
167
168        if( $e =~ /\A(?:To[ ]*:)?[<](.+[@].+)[>]:[ \t]*\z/ ) {
169            # <kijitora@example.jp>:
170            if( $v->{'recipient'} ) {
171                # There are multiple recipient addresses in the message body.
172                push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
173                $v = $dscontents->[-1];
174            }
175            $v->{'recipient'} = $1;
176            $recipients++;
177
178        } elsif( scalar @$dscontents == $recipients ) {
179            # Append error message
180            next unless length $e;
181            $v->{'diagnosis'} .= $e.' ';
182            $v->{'alterrors'}  = $e if index($e, $startingof->{'error'}->[0]) == 0;
183
184            next if $v->{'rhost'};
185            $v->{'rhost'} = $1 if $e =~ $rehost;
186        }
187    }
188    return undef unless $recipients;
189
190    for my $e ( @$dscontents ) {
191        $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
192
193        unless( $e->{'command'} ) {
194            # Get the SMTP command name for the session
195            SMTP: for my $r ( keys %$resmtp ) {
196                # Verify each regular expression of SMTP commands
197                next unless $e->{'diagnosis'} =~ $resmtp->{ $r };
198                $e->{'command'} = uc $r;
199                last;
200            }
201
202            unless( $e->{'command'} ) {
203                # Verify each regular expression of patches
204                $e->{'command'} = uc $1 if $e->{'diagnosis'} =~ $recommands;
205            }
206        }
207
208        # Detect the reason of bounce
209        if( $e->{'command'} eq 'MAIL' ) {
210            # MAIL | Connected to 192.0.2.135 but sender was rejected.
211            $e->{'reason'} = 'rejected';
212
213        } elsif( $e->{'command'} eq 'HELO' || $e->{'command'} eq 'EHLO' ) {
214            # HELO | Connected to 192.0.2.135 but my name was rejected.
215            $e->{'reason'} = 'blocked';
216
217        } else {
218            # Try to match with each error message in the table
219            if( $e->{'diagnosis'} =~ $reisonhold ) {
220                # To decide the reason require pattern match with
221                # Sisimai::Reason::* modules
222                $e->{'reason'} = 'onhold';
223
224            } else {
225                SESSION: for my $r ( keys %$messagesof ) {
226                    # Verify each regular expression of session errors
227                    if( $e->{'alterrors'} ) {
228                        # Check the value of "alterrors"
229                        next unless grep { index($e->{'alterrors'}, $_) > -1 } @{ $messagesof->{ $r } };
230                        $e->{'reason'} = $r;
231                    }
232                    last if $e->{'reason'};
233
234                    next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $messagesof->{ $r } };
235                    $e->{'reason'} = $r;
236                    last;
237                }
238
239                unless( $e->{'reason'} ) {
240                    LDAP: for my $r ( keys %$failonldap ) {
241                        # Verify each regular expression of LDAP errors
242                        next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $failonldap->{ $r } };
243                        $e->{'reason'} = $r;
244                        last;
245                    }
246                }
247
248                unless( $e->{'reason'} ) {
249                    $e->{'reason'} = 'expired' if index($e->{'diagnosis'}, $hasexpired) > -1;
250                }
251            }
252        }
253        $e->{'command'} ||= '';
254    }
255    return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
256}
257
2581;
259__END__
260
261=encoding utf-8
262
263=head1 NAME
264
265Sisimai::Lhost::X4 - bounce mail parser class for Unknown MTA which is
266developed as a C<qmail> clone.
267
268=head1 SYNOPSIS
269
270    use Sisimai::Lhost::X4;
271
272=head1 DESCRIPTION
273
274Sisimai::Lhost::X4 parses a bounce email which created by some C<qmail>
275clone. Methods in the module are called from only Sisimai::Message.
276
277=head1 CLASS METHODS
278
279=head2 C<B<description()>>
280
281C<description()> returns description string of this module.
282
283    print Sisimai::Lhost::X4->description;
284
285=head2 C<B<make(I<header data>, I<reference to body string>)>>
286
287C<make()> method parses a bounced email and return results as a array reference.
288See Sisimai::Message for more details.
289
290=head1 AUTHOR
291
292azumakuniyuki
293
294=head1 COPYRIGHT
295
296Copyright (C) 2015-2020 azumakuniyuki, All rights reserved.
297
298=head1 LICENSE
299
300This software is distributed under The BSD 2-Clause License.
301
302=cut
303
304