File Coverage

lib/Sisimai/Lhost/Exim.pm
Criterion Covered Total %
statement 165 169 97.6
branch 110 132 83.3
condition 50 67 74.6
subroutine 6 6 100.0
pod 2 2 100.0
total 333 376 88.5


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::Exim;
2 30     30   6857 use parent 'Sisimai::Lhost';
  30         68  
  30         177  
3 30     30   1907 use feature ':5.10';
  30         258  
  30         2233  
4 30     30   328 use strict;
  30         65  
  30         654  
5 30     30   139 use warnings;
  30         61  
  30         90025  
6              
7 2     2 1 1214 sub description { 'Exim' }
8             sub make {
9             # Detect an error from Exim
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 543     543 1 1332 my $class = shift;
16 543   100     1449 my $mhead = shift // return undef;
17 542   50     1346 my $mbody = shift // return undef;
18 542         837 my $match = 0;
19 542 50       1809 return undef if $mhead->{'from'} =~/[@].+[.]mail[.]ru[>]?/;
20              
21             # Message-Id:
22             # X-Failed-Recipients: kijitora@example.ed.jp
23 542 100       1907 $match++ if index($mhead->{'from'}, 'Mail Delivery System') == 0;
24             $match++ if defined $mhead->{'message-id'} &&
25 542 100 100     3598 $mhead->{'message-id'} =~ /\A[<]\w{7}[-]\w{6}[-]\w{2}[@]/;
26 542 100       6365 $match++ if $mhead->{'subject'} =~ qr{(?:
27             Mail[ ]delivery[ ]failed(:[ ]returning[ ]message[ ]to[ ]sender)?
28             |Warning:[ ]message[ ][^ ]+[ ]delayed[ ]+
29             |Delivery[ ]Status[ ]Notification
30             |Mail[ ]failure
31             |Message[ ]frozen
32             |error[(]s[)][ ]in[ ]forwarding[ ]or[ ]filtering
33             )
34             }x;
35 542 100       2218 return undef if $match < 2;
36              
37 223         532 state $indicators = __PACKAGE__->INDICATORS;
38 223         393 state $rebackbone = qr{^(?:
39             # deliver.c:6423| if (bounce_return_body) fprintf(f,
40             # deliver.c:6424|"------ This is a copy of the message, including all the headers. ------\n");
41             # deliver.c:6425| else fprintf(f,
42             # deliver.c:6426|"------ This is a copy of the message's headers. ------\n");
43             [-]+[ ]This[ ]is[ ]a[ ]copy[ ]of[ ](?:the|your)[ ]message,[ ]including[ ]all[ ]the[ ]headers[.][ ][-]+
44             |Content-Type:[ ]*message/rfc822\n(?:[\s\t]+.*?\n\n)?
45             )
46             }msx;
47 223         401 state $startingof = { 'deliverystatus' => ['Content-type: message/delivery-status'] };
48 223         461 state $markingsof = {
49             # Error text regular expressions which defined in exim/src/deliver.c
50             #
51             # deliver.c:6292| fprintf(f,
52             # deliver.c:6293|"This message was created automatically by mail delivery software.\n");
53             # deliver.c:6294| if (to_sender)
54             # deliver.c:6295| {
55             # deliver.c:6296| fprintf(f,
56             # deliver.c:6297|"\nA message that you sent could not be delivered to one or more of its\n"
57             # deliver.c:6298|"recipients. This is a permanent error. The following address(es) failed:\n");
58             # deliver.c:6299| }
59             # deliver.c:6300| else
60             # deliver.c:6301| {
61             # deliver.c:6302| fprintf(f,
62             # deliver.c:6303|"\nA message sent by\n\n <%s>\n\n"
63             # deliver.c:6304|"could not be delivered to one or more of its recipients. The following\n"
64             # deliver.c:6305|"address(es) failed:\n", sender_address);
65             # deliver.c:6306| }
66             'alias' => qr/\A([ ]+an undisclosed address)\z/,
67             'message' => qr{\A(?>
68             This[ ]message[ ]was[ ]created[ ]automatically[ ]by[ ]mail[ ]delivery[ ]software[.]
69             |A[ ]message[ ]that[ ]you[ ]sent[ ]was[ ]rejected[ ]by[ ]the[ ]local[ ]scannning[ ]code
70             |A[ ]message[ ]that[ ]you[ ]sent[ ]contained[ ]one[ ]or[ ]more[ ]recipient[ ]addresses[ ]
71             |A[ ]message[ ]that[ ]you[ ]sent[ ]could[ ]not[ ]be[ ]delivered[ ]to[ ]all[ ]of[ ]its[ ]recipients
72             |Message[ ][^ ]+[ ](?:has[ ]been[ ]frozen|was[ ]frozen[ ]on[ ]arrival)
73             |The[ ][^ ]+[ ]router[ ]encountered[ ]the[ ]following[ ]error[(]s[)]:
74             )
75             }x,
76             'frozen' => qr/\AMessage [^ ]+ (?:has been frozen|was frozen on arrival)/,
77             };
78 223         407 state $recommands = [
79             # transports/smtp.c:564| *message = US string_sprintf("SMTP error from remote mail server after %s%s: "
80             # transports/smtp.c:837| string_sprintf("SMTP error from remote mail server after RCPT TO:<%s>: "
81             qr/SMTP error from remote (?:mail server|mailer) after ([A-Za-z]{4})/,
82             qr/SMTP error from remote (?:mail server|mailer) after end of ([A-Za-z]{4})/,
83             qr/LMTP error after ([A-Za-z]{4})/,
84             qr/LMTP error after end of ([A-Za-z]{4})/,
85             ];
86 223         439 state $messagesof = {
87             # find exim/ -type f -exec grep 'message = US' {} /dev/null \;
88             # route.c:1158| DEBUG(D_uid) debug_printf("getpwnam() returned NULL (user not found)\n");
89             'userunknown' => ['user not found'],
90             # transports/smtp.c:3524| addr->message = US"all host address lookups failed permanently";
91             # routers/dnslookup.c:331| addr->message = US"all relevant MX records point to non-existent hosts";
92             # route.c:1826| uschar *message = US"Unrouteable address";
93             'hostunknown' => [
94             'all host address lookups failed permanently',
95             'all relevant MX records point to non-existent hosts',
96             'Unrouteable address',
97             ],
98             # transports/appendfile.c:2567| addr->user_message = US"mailbox is full";
99             # transports/appendfile.c:3049| addr->message = string_sprintf("mailbox is full "
100             # transports/appendfile.c:3050| "(quota exceeded while writing to file %s)", filename);
101             'mailboxfull' => [
102             'mailbox is full',
103             'error: quota exceed',
104             ],
105             # routers/dnslookup.c:328| addr->message = US"an MX or SRV record indicated no SMTP service";
106             # transports/smtp.c:3502| addr->message = US"no host found for existing SMTP connection";
107             'notaccept' => [
108             'an MX or SRV record indicated no SMTP service',
109             'no host found for existing SMTP connection',
110             ],
111             # parser.c:666| *errorptr = string_sprintf("%s (expected word or \"<\")", *errorptr);
112             # parser.c:701| if(bracket_count++ > 5) FAILED(US"angle-brackets nested too deep");
113             # parser.c:738| FAILED(US"domain missing in source-routed address");
114             # parser.c:747| : string_sprintf("malformed address: %.32s may not follow %.*s",
115             'syntaxerror' => [
116             'angle-brackets nested too deep',
117             'expected word or "<"',
118             'domain missing in source-routed address',
119             'malformed address:',
120             ],
121             # deliver.c:5614| addr->message = US"delivery to file forbidden";
122             # deliver.c:5624| addr->message = US"delivery to pipe forbidden";
123             # transports/pipe.c:1156| addr->user_message = US"local delivery failed";
124             'systemerror' => [
125             'delivery to file forbidden',
126             'delivery to pipe forbidden',
127             'local delivery failed',
128             'LMTP error after ',
129             ],
130             # deliver.c:5425| new->message = US"Too many \"Received\" headers - suspected mail loop";
131             'contenterror' => ['Too many "Received" headers'],
132             };
133 223         318 state $delayedfor = [
134             # retry.c:902| addr->message = (addr->message == NULL)? US"retry timeout exceeded" :
135             # deliver.c:7475| "No action is required on your part. Delivery attempts will continue for\n"
136             # smtp.c:3508| US"retry time not reached for any host after a long failure period" :
137             # smtp.c:3508| US"all hosts have been failing for a long time and were last tried "
138             # "after this message arrived";
139             # deliver.c:7459| print_address_error(addr, f, US"Delay reason: ");
140             # deliver.c:7586| "Message %s has been frozen%s.\nThe sender is <%s>.\n", message_id,
141             # receive.c:4021| moan_tell_someone(freeze_tell, NULL, US"Message frozen on arrival",
142             # receive.c:4022| "Message %s was frozen on arrival by %s.\nThe sender is <%s>.\n",
143             'retry timeout exceeded',
144             'No action is required on your part',
145             'retry time not reached for any host after a long failure period',
146             'all hosts have been failing for a long time and were last tried',
147             'Delay reason: ',
148             'has been frozen',
149             'was frozen on arrival by ',
150             ];
151              
152 223         1657 require Sisimai::RFC1894;
153 223         1191 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
154 223         898 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
155 223         1224 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
156 223         481 my $readcursor = 0; # (Integer) Points the current cursor position
157 223         346 my $nextcursor = 0;
158 223         404 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
159 223         395 my $localhost0 = ''; # (String) Local MTA
160 223         400 my $boundary00 = ''; # (String) Boundary string
161 223         390 my $v = undef;
162              
163 223 100       647 if( $mhead->{'content-type'} ) {
164             # Get the boundary string and set regular expression for matching with
165             # the boundary string.
166 41         187 $boundary00 = Sisimai::MIME->boundary($mhead->{'content-type'});
167             }
168              
169 223         1631 for my $e ( split("\n", $emailsteak->[0]) ) {
170             # Read error messages and delivery status lines from the head of the email
171             # to the previous line of the beginning of the original message.
172 2707 100       3990 unless( $readcursor ) {
173             # Beginning of the bounce message or message/delivery-status part
174 263 100       2192 if( $e =~ $markingsof->{'message'} ) {
175 223         586 $readcursor |= $indicators->{'deliverystatus'};
176 223 50       1328 next unless $e =~ $markingsof->{'frozen'};
177             }
178             }
179 2484 100       4237 next unless $readcursor & $indicators->{'deliverystatus'};
180 2444 100       3727 next unless length $e;
181              
182             # This message was created automatically by mail delivery software.
183             #
184             # A message that you sent could not be delivered to one or more of its
185             # recipients. This is a permanent error. The following address(es) failed:
186             #
187             # kijitora@example.jp
188             # SMTP error from remote mail server after RCPT TO::
189             # host neko.example.jp [192.0.2.222]: 550 5.1.1 ... User Unknown
190 1829         2157 $v = $dscontents->[-1];
191              
192 1829 100 100     14971 if( $e =~ /\A[ \t]{2}([^ \t]+[@][^ \t]+[.]?[a-zA-Z]+)(:.+)?\z/ ||
    100 66        
      100        
193             $e =~ /\A[ \t]{2}[^ \t]+[@][^ \t]+[.][a-zA-Z]+[ ]<(.+?[@].+?)>:.+\z/ ||
194             $e =~ $markingsof->{'alias'} ) {
195             # kijitora@example.jp
196             # sabineko@example.jp: forced freeze
197             # mikeneko@example.jp : ...
198             #
199             # deliver.c:4549| printed = US"an undisclosed address";
200             # an undisclosed address
201             # (generated from kijitora@example.jp)
202 187         668 my $r = $1;
203              
204 187 100       600 if( $v->{'recipient'} ) {
205             # There are multiple recipient addresses in the message body.
206 5         24 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
207 5         21 $v = $dscontents->[-1];
208             }
209              
210 187 100       621 if( $e =~ /\A[ \t]+[^ \t]+[@][^ \t]+[.][a-zA-Z]+[ ]<(.+?[@].+?)>:.+\z/ ) {
211             # parser.c:743| while (bracket_count-- > 0) if (*s++ != '>')
212             # parser.c:744| {
213             # parser.c:745| *errorptr = s[-1] == 0
214             # parser.c:746| ? US"'>' missing at end of address"
215             # parser.c:747| : string_sprintf("malformed address: %.32s may not follow %.*s",
216             # parser.c:748| s-1, (int)(s - US mailbox - 1), mailbox);
217             # parser.c:749| goto PARSE_FAILED;
218             # parser.c:750| }
219 5         15 $r = $1;
220 5         12 $v->{'diagnosis'} = $e;
221             }
222 187         449 $v->{'recipient'} = $r;
223 187         348 $recipients++;
224              
225             } elsif( $e =~ /\A[ ]+[(]generated[ ]from[ ](.+)[)]\z/ ||
226             $e =~ /\A[ ]+generated[ ]by[ ]([^ \t]+[@][^ \t]+)/ ) {
227             # (generated from kijitora@example.jp)
228             # pipe to |/bin/echo "Some pipe output"
229             # generated by userx@myhost.test.ex
230 31         112 $v->{'alias'} = $1;
231              
232             } else {
233 1611 50       2821 next unless length $e;
234              
235 1611 50       3737 if( $e =~ $markingsof->{'frozen'} ) {
236             # Message *** has been frozen by the system filter.
237             # Message *** was frozen on arrival by ACL.
238 0         0 $v->{'alterrors'} .= $e.' ';
239              
240             } else {
241 1611 100       2348 if( $boundary00 ) {
242             # --NNNNNNNNNN-eximdsn-MMMMMMMMMM
243             # Content-type: message/delivery-status
244             # ...
245 355 100       753 if( Sisimai::RFC1894->match($e) ) {
246             # $e matched with any field defined in RFC3464
247 160 50       348 next unless my $o = Sisimai::RFC1894->field($e);
248              
249 160 100       417 if( $o->[-1] eq 'addr' ) {
    100          
250             # Final-Recipient: rfc822;|/bin/echo "Some pipe output"
251 30 50       131 next unless $o->[0] eq 'final-recipient';
252 30 100 33     246 $v->{'spec'} ||= rindex($o->[2], '@') > -1 ? 'SMTP' : 'X-UNIX';
253              
254             } elsif( $o->[-1] eq 'code' ) {
255             # Diagnostic-Code: SMTP; 550 5.1.1 ... User Unknown
256 20         76 $v->{'spec'} = uc $o->[1];
257 20         70 $v->{'diagnosis'} = $o->[2];
258              
259             } else {
260             # Other DSN fields defined in RFC3464
261 110 50       242 next unless exists $fieldtable->{ $o->[0] };
262 110         372 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
263             }
264             } else {
265             # Error message ?
266 195 50       412 next if $nextcursor;
267             # Content-type: message/delivery-status
268 195 50       520 $nextcursor = 1 if index($e, $startingof->{'deliverystatus'}) == 0;
269 195 100       680 $v->{'alterrors'} .= $e.' ' if index($e, ' ') == 0;
270             }
271             } else {
272 1256 100       2009 if( scalar @$dscontents == $recipients ) {
273             # Error message
274 524 50       946 next unless length $e;
275 524         1438 $v->{'diagnosis'} .= $e.' ';
276              
277             } else {
278             # Error message when email address above does not include '@'
279             # and domain part.
280 732 100       1343 if( $e =~ m<\A[ ]+pipe[ ]to[ ][|]/[^ ]+> ) {
281             # pipe to |/path/to/prog ...
282             # generated by kijitora@example.com
283 5         19 $v->{'diagnosis'} = $e;
284              
285             } else {
286 727 100       1796 next unless index($e, ' ') == 0;
287 61         233 $v->{'alterrors'} .= $e.' ';
288             }
289             }
290             }
291             }
292             }
293             }
294              
295 223 100       850 if( $recipients ) {
296             # Check "an undisclosed address", "unroutable address"
297 182         424 for my $q ( @$dscontents ) {
298             # Replace the recipient address with the value of "alias"
299 187 100       617 next unless $q->{'alias'};
300 6 50 33     43 if( ! $q->{'recipient'} || rindex($q->{'recipient'}, '@') == -1 ) {
301             # The value of "recipient" is empty or does not include "@"
302 0         0 $q->{'recipient'} = $q->{'alias'};
303             }
304             }
305             } else {
306             # Fallback for getting recipient addresses
307 41 100       204 if( defined $mhead->{'x-failed-recipients'} ) {
308             # X-Failed-Recipients: kijitora@example.jp
309 30         134 my @rcptinhead = split(',', $mhead->{'x-failed-recipients'});
310 30         77 for my $e ( @rcptinhead ) { $e =~ s/\A[ ]+//; $e =~ s/[ ]+\z// }
  30         76  
  30         77  
311 30         61 $recipients = scalar @rcptinhead;
312              
313 30         66 for my $e ( @rcptinhead ) {
314             # Insert each recipient address into @$dscontents
315 30         81 $dscontents->[-1]->{'recipient'} = $e;
316 30 50       137 next if scalar @$dscontents == $recipients;
317 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
318             }
319             }
320             }
321 223 100       595 return undef unless $recipients;
322              
323 212 100       373 if( scalar @{ $mhead->{'received'} } ) {
  212         724  
324             # Get the name of local MTA
325             # Received: from marutamachi.example.org (c192128.example.net [192.0.2.128])
326 206 50       1686 $localhost0 = $1 if $mhead->{'received'}->[-1] =~ /from[ \t]([^ ]+) /;
327             }
328              
329 212         536 for my $e ( @$dscontents ) {
330             # Set default values if each value is empty.
331 217   66     1056 $e->{'lhost'} ||= $localhost0;
332              
333 217 100 100     793 if( ! $e->{'diagnosis'} && length($boundary00) > 0 ) {
334             # Empty Diagnostic-Code: or error message
335             # --NNNNNNNNNN-eximdsn-MMMMMMMMMM
336             # Content-type: message/delivery-status
337             #
338             # Reporting-MTA: dns; the.local.host.name
339             #
340             # Action: failed
341             # Final-Recipient: rfc822;/a/b/c
342             # Status: 5.0.0
343             #
344             # Action: failed
345             # Final-Recipient: rfc822;|/p/q/r
346             # Status: 5.0.0
347 10   50     72 $e->{'diagnosis'} = $dscontents->[0]->{'diagnosis'} || '';
348 10   33     35 $e->{'spec'} ||= $dscontents->[0]->{'spec'};
349              
350 10 50       34 if( $dscontents->[0]->{'alterrors'} ) {
351             # The value of "alterrors" is also copied
352 10         30 $e->{'alterrors'} = $dscontents->[0]->{'alterrors'};
353             }
354             }
355              
356 217 50 66     752 if( exists $e->{'alterrors'} && $e->{'alterrors'} ) {
357             # Copy alternative error message
358 45   66     192 $e->{'diagnosis'} ||= $e->{'alterrors'};
359              
360 45 50 33     356 if( index($e->{'diagnosis'}, '-') == 0 || substr($e->{'diagnosis'}, -2, 2) eq '__' ) {
361             # Override the value of diagnostic code message
362 0 0       0 $e->{'diagnosis'} = $e->{'alterrors'} if $e->{'alterrors'};
363              
364             } else {
365             # Check the both value and try to match
366 45 100       159 if( length($e->{'diagnosis'}) < length($e->{'alterrors'}) ) {
367             # Check the value of alterrors
368 20         320 my $rxdiagnosis = qr/\Q$e->{'diagnosis'}\E/i;
369 20 50       198 if( $e->{'alterrors'} =~ $rxdiagnosis ) {
370             # Override the value of diagnostic code message because
371             # the value of alterrors includes the value of diagnosis.
372 20         80 $e->{'diagnosis'} = $e->{'alterrors'};
373             }
374             }
375             }
376 45         101 delete $e->{'alterrors'};
377             }
378 217         1505 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
379 217         591 $e->{'diagnosis'} =~ s/\b__.+\z//;
380              
381 217 100       569 unless( $e->{'rhost'} ) {
382             # Get the remote host name
383             # host neko.example.jp [192.0.2.222]: 550 5.1.1 ... User Unknown
384 187 100       1190 $e->{'rhost'} = $1 if $e->{'diagnosis'} =~ /host[ \t]+([^ \t]+)[ \t]\[.+\]:[ \t]/;
385              
386 187 50 100     682 if( ! $e->{'rhost'} && scalar @{ $mhead->{'received'} } ) {
  115         458  
387             # Get localhost and remote host name from Received header.
388 115         218 my $r0 = $mhead->{'received'};
389 115         161 $e->{'rhost'} = pop @{ Sisimai::RFC5322->received($r0->[-1]) };
  115         500  
390             }
391             }
392              
393 217 50       655 unless( $e->{'command'} ) {
394             # Get the SMTP command name for the session
395 217         597 SMTP: for my $r ( @$recommands ) {
396             # Verify each regular expression of SMTP commands
397 383 100       2595 next unless $e->{'diagnosis'} =~ $r;
398 172         609 $e->{'command'} = uc $1;
399 172         280 last;
400             }
401              
402             # Detect the reason of bounce
403 217 100 66     1517 if( $e->{'command'} eq 'HELO' || $e->{'command'} eq 'EHLO' ) {
    100          
404             # HELO | Connected to 192.0.2.135 but my name was rejected.
405 5         16 $e->{'reason'} = 'blocked';
406              
407             } elsif( $e->{'command'} eq 'MAIL' ) {
408             # MAIL | Connected to 192.0.2.135 but sender was rejected.
409             # $e->{'reason'} = 'rejected';
410 71         235 $e->{'reason'} = 'onhold';
411              
412             } else {
413             # Verify each regular expression of session errors
414 141         660 SESSION: for my $r ( keys %$messagesof ) {
415             # Check each regular expression
416 942 100       1061 next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $messagesof->{ $r } };
  2284         6344  
  942         1644  
417 15         59 $e->{'reason'} = $r;
418 15         32 last;
419             }
420              
421 141 100       466 unless( $e->{'reason'} ) {
422             # The reason "expired"
423 126 100       348 $e->{'reason'} = 'expired' if grep { index($e->{'diagnosis'}, $_) > -1 } @$delayedfor;
  882         2149  
424             }
425             }
426             }
427              
428             STATUS: {
429             # Prefer the value of smtp reply code in Diagnostic-Code:
430             # See set-of-emails/maildir/bsd/exim-20.eml
431             # Action: failed
432             # Final-Recipient: rfc822;userx@test.ex
433             # Status: 5.0.0
434             # Remote-MTA: dns; 127.0.0.1
435             # Diagnostic-Code: smtp; 450 TEMPERROR: retry timeout exceeded
436             # The value of "Status:" indicates permanent error but the value
437             # of SMTP reply code in Diagnostic-Code: field is "TEMPERROR"!!!!
438 217   100     384 my $sv = $e->{'status'} || Sisimai::SMTP::Status->find($e->{'diagnosis'}) || '';
  217         1885  
439 217   100     1622 my $rv = $e->{'replycode'} || Sisimai::SMTP::Reply->find($e->{'diagnosis'}) || '';
440 217         489 my $s1 = 0; # First character of Status as integer
441 217         307 my $r1 = 0; # First character of SMTP reply code as integer
442 217         344 my $v1 = 0;
443              
444 217         348 FIND_CODE: while(1) {
445             # "Status:" field did not exist in the bounce message
446 217 100       573 last if $sv;
447 100 100       315 last unless $rv;
448              
449             # Check SMTP reply code
450             # Generate pseudo DSN code from SMTP reply code
451 60         174 $r1 = substr($rv, 0, 1);
452 60 100       328 if( $r1 == 4 ) {
    50          
453             # Get the internal DSN(temporary error)
454 10   50     45 $sv = Sisimai::SMTP::Status->code($e->{'reason'}, 1) || '';
455              
456             } elsif( $r1 == 5 ) {
457             # Get the internal DSN(permanent error)
458 50   100     205 $sv = Sisimai::SMTP::Status->code($e->{'reason'}, 0) || '';
459             }
460 60         113 last;
461             }
462              
463 217 100       639 $s1 = substr($sv, 0, 1) if $sv;
464 217         612 $v1 = $s1 + $r1;
465 217 100       602 $v1 += substr($e->{'status'}, 0, 1) if $e->{'status'};
466              
467 217 100       580 if( $v1 > 0 ) {
468             # Status or SMTP reply code exists
469             # Set pseudo DSN into the value of "status" accessor
470 177 100       487 $e->{'status'} = $sv if $r1 > 0;
471              
472             } else {
473             # Neither Status nor SMTP reply code exist
474 40 100 100     201 if( $e->{'reason'} eq 'expired' || $e->{'reason'} eq 'mailboxfull' ) {
475             # Set pseudo DSN (temporary error)
476 15   50     62 $sv = Sisimai::SMTP::Status->code($e->{'reason'}, 1) || '';
477              
478             } else {
479             # Set pseudo DSN (permanent error)
480 25   100     112 $sv = Sisimai::SMTP::Status->code($e->{'reason'}, 0) || '';
481             }
482             }
483 217   100     843 $e->{'status'} ||= $sv;
484             }
485 217   100     747 $e->{'command'} ||= '';
486             }
487 212         1654 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
488             }
489              
490             1;
491             __END__