File Coverage

lib/Sisimai/Lhost/qmail.pm
Criterion Covered Total %
statement 93 95 97.8
branch 55 60 91.6
condition 12 15 80.0
subroutine 6 6 100.0
pod 2 2 100.0
total 168 178 94.3


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::qmail;
2 19     19   6071 use parent 'Sisimai::Lhost';
  19         40  
  19         104  
3 19     19   1147 use feature ':5.10';
  19         35  
  19         1250  
4 19     19   107 use strict;
  19         33  
  19         364  
5 19     19   90 use warnings;
  19         38  
  19         30367  
6              
7 2     2 1 1167 sub description { 'qmail' }
8             sub make {
9             # Detect an error from qmail
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.0.0
15 280     280 1 940 my $class = shift;
16 280   100     817 my $mhead = shift // return undef;
17 279   50     869 my $mbody = shift // return undef;
18 279         454 my $match = 0;
19 279         1122 my $tryto = qr/\A[(]qmail[ ]+\d+[ ]+invoked[ ]+(?:for[ ]+bounce|from[ ]+network)[)]/;
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 279 100 50     1368 $match ||= 1 if $mhead->{'subject'} eq 'failure notice';
26 279 100 100     537 $match ||= 1 if grep { $_ =~ $tryto } @{ $mhead->{'received'} };
  438         2698  
  279         770  
27 279 100       1108 return undef unless $match;
28              
29 83         184 state $indicators = __PACKAGE__->INDICATORS;
30 83         165 state $rebackbone = qr|^--- Below this line is a copy of the message[.]|m;
31 83         155 state $startingof = {
32             # qmail-remote.c:248| if (code >= 500) {
33             # qmail-remote.c:249| out("h"); outhost(); out(" does not like recipient.\n");
34             # qmail-remote.c:265| if (code >= 500) quit("D"," failed on DATA command");
35             # qmail-remote.c:271| if (code >= 500) quit("D"," failed after I sent the message");
36             #
37             # Characters: K,Z,D in qmail-qmqpc.c, qmail-send.c, qmail-rspawn.c
38             # K = success, Z = temporary error, D = permanent error
39             'message' => ['Hi. This is the qmail'],
40             'error' => ['Remote host said:'],
41             };
42              
43 83         209 state $resmtp = {
44             # Error text regular expressions which defined in qmail-remote.c
45             # qmail-remote.c:225| if (smtpcode() != 220) quit("ZConnected to "," but greeting failed");
46             'conn' => qr/(?:Error:)?Connected to [^ ]+ but greeting failed[.]/,
47             # qmail-remote.c:231| if (smtpcode() != 250) quit("ZConnected to "," but my name was rejected");
48             'ehlo' => qr/(?:Error:)?Connected to [^ ]+ but my name was rejected[.]/,
49             # qmail-remote.c:238| if (code >= 500) quit("DConnected to "," but sender was rejected");
50             # reason = rejected
51             'mail' => qr/(?:Error:)?Connected to [^ ]+ but sender was rejected[.]/,
52             # qmail-remote.c:249| out("h"); outhost(); out(" does not like recipient.\n");
53             # qmail-remote.c:253| out("s"); outhost(); out(" does not like recipient.\n");
54             # reason = userunknown
55             'rcpt' => qr/(?:Error:)?[^ ]+ does not like recipient[.]/,
56             # qmail-remote.c:265| if (code >= 500) quit("D"," failed on DATA command");
57             # qmail-remote.c:266| if (code >= 400) quit("Z"," failed on DATA command");
58             # qmail-remote.c:271| if (code >= 500) quit("D"," failed after I sent the message");
59             # qmail-remote.c:272| if (code >= 400) quit("Z"," failed after I sent the message");
60             'data' => qr{(?:
61             (?:Error:)?[^ ]+[ ]failed[ ]on[ ]DATA[ ]command[.]
62             |(?:Error:)?[^ ]+[ ]failed[ ]after[ ]I[ ]sent[ ]the[ ]message[.]
63             )
64             }x,
65             };
66 83         148 state $rehost = qr{(?:
67             # qmail-remote.c:261| if (!flagbother) quit("DGiving up on ","");
68             Giving[ ]up[ ]on[ ]([^ ]+[0-9a-zA-Z])[.]?\z
69             |Connected[ ]to[ ]([-0-9a-zA-Z.]+[0-9a-zA-Z])[ ]
70             |remote[ ]host[ ]([-0-9a-zA-Z.]+[0-9a-zA-Z])[ ]said:
71             )
72             }x;
73              
74             # qmail-send.c:922| ... (&dline[c],"I'm not going to try again; this message has been in the queue too long.\n")) nomem();
75 83         127 state $hasexpired = 'this message has been in the queue too long.';
76             # qmail-remote-fallback.patch
77 83         135 state $recommands = qr/Sorry, no SMTP connection got far enough; most progress was ([A-Z]{4}) /;
78 83         141 state $reisonhold = qr/\A[^ ]+ does not like recipient[.][ \t]+.+this message has been in the queue too long[.]\z/;
79 83         164 state $failonldap = {
80             # qmail-ldap-1.03-20040101.patch:19817 - 19866
81             'suspend' => ['Mailaddress is administrative?le?y disabled'], # 5.2.1
82             'userunknown' => ['Sorry, no mailbox here by that name'], # 5.1.1
83             'exceedlimit' => ['The message exeeded the maximum size the user accepts'], # 5.2.3
84             'systemerror' => [
85             'Automatic homedir creator crashed', # 4.3.0
86             'Illegal value in LDAP attribute', # 5.3.5
87             'LDAP attribute is not given but mandatory', # 5.3.5
88             'Timeout while performing search on LDAP server', # 4.4.3
89             'Too many results returned but needs to be unique', # 5.3.5
90             'Permanent error while executing qmail-forward', # 5.4.4
91             'Temporary error in automatic homedir creation', # 4.3.0 or 5.3.0
92             'Temporary error while executing qmail-forward', # 4.4.4
93             'Temporary failure in LDAP lookup', # 4.4.3
94             'Unable to contact LDAP server', # 4.4.3
95             'Unable to login into LDAP server, bad credentials',# 4.4.3
96             ],
97             };
98 83         157 state $messagesof = {
99             # qmail-local.c:589| strerr_die1x(100,"Sorry, no mailbox here by that name. (#5.1.1)");
100             # qmail-remote.c:253| out("s"); outhost(); out(" does not like recipient.\n");
101             'userunknown' => [
102             'no mailbox here by that name',
103             'does not like recipient.',
104             ],
105             # error_str.c:192| X(EDQUOT,"disk quota exceeded")
106             'mailboxfull' => ['disk quota exceeded'],
107             # qmail-qmtpd.c:233| ... result = "Dsorry, that message size exceeds my databytes limit (#5.3.4)";
108             # qmail-smtpd.c:391| ... out("552 sorry, that message size exceeds my databytes limit (#5.3.4)\r\n"); return;
109             'mesgtoobig' => ['Message size exceeds fixed maximum message size:'],
110             # qmail-remote.c:68| Sorry, I couldn't find any host by that name. (#4.1.2)\n"); zerodie();
111             # qmail-remote.c:78| Sorry, I couldn't find any host named ");
112             'hostunknown' => ["Sorry, I couldn't find any host "],
113             'systemfull' => ['Requested action not taken: mailbox unavailable (not enough free space)'],
114             'systemerror' => [
115             'bad interpreter: No such file or directory',
116             'system error',
117             'Unable to',
118             ],
119             'networkerror'=> [
120             "Sorry, I wasn't able to establish an SMTP connection",
121             "Sorry, I couldn't find a mail exchanger or IP address",
122             "Sorry. Although I'm listed as a best-preference MX or A for that host",
123             ],
124             };
125              
126 83         323 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
127 83         477 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
128 83         187 my $readcursor = 0; # (Integer) Points the current cursor position
129 83         151 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
130 83         143 my $v = undef;
131              
132 83         622 for my $e ( split("\n", $emailsteak->[0]) ) {
133             # Read error messages and delivery status lines from the head of the email
134             # to the previous line of the beginning of the original message.
135 1130 100       1574 unless( $readcursor ) {
136             # Beginning of the bounce message or message/delivery-status part
137 745 100       1345 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
138 745         834 next;
139             }
140 385 50       673 next unless $readcursor & $indicators->{'deliverystatus'};
141 385 100       621 next unless length $e;
142              
143             # :
144             # 192.0.2.153 does not like recipient.
145             # Remote host said: 550 5.1.1 ... User Unknown
146             # Giving up on 192.0.2.153.
147 330         443 $v = $dscontents->[-1];
148              
149 330 100       1093 if( $e =~ /\A(?:To[ ]*:)?[<](.+[@].+)[>]:[ \t]*\z/ ) {
    100          
150             # :
151 60 100       233 if( $v->{'recipient'} ) {
152             # There are multiple recipient addresses in the message body.
153 5         22 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
154 5         12 $v = $dscontents->[-1];
155             }
156 60         191 $v->{'recipient'} = $1;
157 60         133 $recipients++;
158              
159             } elsif( scalar @$dscontents == $recipients ) {
160             # Append error message
161 160 50       312 next unless length $e;
162 160         372 $v->{'diagnosis'} .= $e.' ';
163 160 100       512 $v->{'alterrors'} = $e if index($e, $startingof->{'error'}->[0]) == 0;
164              
165 160 100       314 next if $v->{'rhost'};
166 155 100       1057 $v->{'rhost'} = $1 if $e =~ $rehost;
167             }
168             }
169 83 100       454 return undef unless $recipients;
170              
171 55         125 for my $e ( @$dscontents ) {
172 60         367 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
173              
174 60 50       204 if( ! $e->{'command'} ) {
175             # Get the SMTP command name for the session
176 60         243 SMTP: for my $r ( keys %$resmtp ) {
177             # Verify each regular expression of SMTP commands
178 279 100       6395 next unless $e->{'diagnosis'} =~ $resmtp->{ $r };
179 39         111 $e->{'command'} = uc $r;
180 39         74 last;
181             }
182              
183 60 100       183 unless( $e->{'command'} ) {
184             # Verify each regular expression of patches
185 21 100       151 $e->{'command'} = uc $1 if $e->{'diagnosis'} =~ $recommands;
186             }
187             }
188              
189             # Detect the reason of bounce
190 60 100 66     379 if( $e->{'command'} eq 'MAIL' ) {
    100          
191             # MAIL | Connected to 192.0.2.135 but sender was rejected.
192 5         15 $e->{'reason'} = 'rejected';
193              
194             } elsif( $e->{'command'} eq 'HELO' || $e->{'command'} eq 'EHLO' ) {
195             # HELO | Connected to 192.0.2.135 but my name was rejected.
196 5         17 $e->{'reason'} = 'blocked';
197              
198             } else {
199             # Try to match with each error message in the table
200 50 100       255 if( $e->{'diagnosis'} =~ $reisonhold ) {
201             # To decide the reason require pattern match with
202             # Sisimai::Reason::* modules
203 5         17 $e->{'reason'} = 'onhold';
204              
205             } else {
206 45         188 SESSION: for my $r ( keys %$messagesof ) {
207             # Verify each regular expression of session errors
208 272 100       461 if( $e->{'alterrors'} ) {
209             # Check the value of "alterrors"
210 153 100       157 next unless grep { index($e->{'alterrors'}, $_) > -1 } @{ $messagesof->{ $r } };
  258         736  
  153         232  
211 5         16 $e->{'reason'} = $r;
212             }
213 124 100       213 last if $e->{'reason'};
214              
215 119 100       155 next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $messagesof->{ $r } };
  205         672  
  119         195  
216 10         33 $e->{'reason'} = $r;
217 10         19 last;
218             }
219              
220 45 100       132 unless( $e->{'reason'} ) {
221 30         93 LDAP: for my $r ( keys %$failonldap ) {
222             # Verify each regular expression of LDAP errors
223 120 50       146 next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $failonldap->{ $r } };
  420         1020  
  120         178  
224 0         0 $e->{'reason'} = $r;
225 0         0 last;
226             }
227             }
228              
229 45 100       155 unless( $e->{'reason'} ) {
230 30 50       136 $e->{'reason'} = 'expired' if index($e->{'diagnosis'}, $hasexpired) > -1;
231             }
232             }
233             }
234 60   100     217 $e->{'command'} ||= '';
235 60   100     356 $e->{'status'} = Sisimai::SMTP::Status->find($e->{'diagnosis'}) || '';
236             }
237 55         385 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
238             }
239              
240             1;
241             __END__