File Coverage

lib/Sisimai/Lhost/Exchange2007.pm
Criterion Covered Total %
statement 61 65 93.8
branch 29 38 76.3
condition 3 4 75.0
subroutine 6 6 100.0
pod 2 2 100.0
total 101 115 87.8


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::Exchange2007;
2 25     25   6113 use parent 'Sisimai::Lhost';
  25         52  
  25         143  
3 25     25   1595 use feature ':5.10';
  25         50  
  25         1822  
4 25     25   159 use strict;
  25         47  
  25         588  
5 25     25   119 use warnings;
  25         55  
  25         26287  
6              
7 2     2 1 1191 sub description { 'Microsoft Exchange Server 2007' }
8             sub make {
9             # Detect an error from Microsoft Exchange Server 2007
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.1
15 340     340 1 1090 my $class = shift;
16 340   100     943 my $mhead = shift // return undef;
17 339   50     1106 my $mbody = shift // return undef;
18              
19             # Content-Language: en-US, fr-FR
20 339 100       1892 return undef unless $mhead->{'subject'} =~ /\A(?:Undeliverable|Non_remis_|Non[ ]recapitabile):/;
21 95 100       420 return undef unless defined $mhead->{'content-language'};
22 42 50       296 return undef unless $mhead->{'content-language'} =~ /\A[a-z]{2}(?:[-][A-Z]{2})?\z/;
23              
24             # These headers exist only a bounce mail from Office365
25 42 50       157 return undef if $mhead->{'x-ms-exchange-crosstenant-originalarrivaltime'};
26 42 50       159 return undef if $mhead->{'x-ms-exchange-crosstenant-fromentityheader'};
27              
28 42         133 state $indicators = __PACKAGE__->INDICATORS;
29 42         118 state $rebackbone = qr{^(?:
30             Original[ ]message[ ]headers: # en-US
31             |En-t.tes[ ]de[ ]message[ ]d'origine[ ]: # fr-FR/En-têtes de message d'origine
32             |Intestazioni[ ]originali[ ]del[ ]messaggio: # it-CH
33             )
34             }mx;
35 42         118 state $markingsof = {
36             'message' => qr{\A(?:
37             Diagnostic[ ]information[ ]for[ ]administrators: # en-US
38             |Informations[ ]de[ ]diagnostic[ ]pour[ ]les[ ]administrateurs # fr-FR
39             |Informazioni[ ]di[ ]diagnostica[ ]per[ ]gli[ ]amministratori # it-CH
40             )
41             }x,
42             'error' => qr/[ ]((?:RESOLVER|QUEUE)[.][A-Za-z]+(?:[.]\w+)?);/,
43             'rhost' => qr{\A(?:
44             Generating[ ]server # en-US
45             |Serveur[ ]de[ ]g[^ ]+ration[ ] # fr-FR/Serveur de génération
46             |Server[ ]di[ ]generazione # it-CH
47             ):[ ]?(.*)
48             }x,
49             };
50 42         130 state $ndrsubject = {
51             'SMTPSEND.DNS.NonExistentDomain'=> 'hostunknown', # 554 5.4.4 SMTPSEND.DNS.NonExistentDomain
52             'SMTPSEND.DNS.MxLoopback' => 'networkerror', # 554 5.4.4 SMTPSEND.DNS.MxLoopback
53             'RESOLVER.ADR.BadPrimary' => 'systemerror', # 550 5.2.0 RESOLVER.ADR.BadPrimary
54             'RESOLVER.ADR.RecipNotFound' => 'userunknown', # 550 5.1.1 RESOLVER.ADR.RecipNotFound
55             'RESOLVER.ADR.ExRecipNotFound' => 'userunknown', # 550 5.1.1 RESOLVER.ADR.ExRecipNotFound
56             'RESOLVER.ADR.RecipLimit' => 'toomanyconn', # 550 5.5.3 RESOLVER.ADR.RecipLimit
57             'RESOLVER.ADR.InvalidInSmtp' => 'systemerror', # 550 5.1.0 RESOLVER.ADR.InvalidInSmtp
58             'RESOLVER.ADR.Ambiguous' => 'systemerror', # 550 5.1.4 RESOLVER.ADR.Ambiguous, 420 4.2.0 RESOLVER.ADR.Ambiguous
59             'RESOLVER.RST.AuthRequired' => 'securityerror', # 550 5.7.1 RESOLVER.RST.AuthRequired
60             'RESOLVER.RST.NotAuthorized' => 'rejected', # 550 5.7.1 RESOLVER.RST.NotAuthorized
61             'RESOLVER.RST.RecipSizeLimit' => 'mesgtoobig', # 550 5.2.3 RESOLVER.RST.RecipSizeLimit
62             'QUEUE.Expired' => 'expired', # 550 4.4.7 QUEUE.Expired
63             };
64              
65 42         208 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
66 42         344 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
67 42         97 my $readcursor = 0; # (Integer) Points the current cursor position
68 42         95 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
69 42         84 my $connvalues = 0; # (Integer) Flag, 1 if all the value of $connheader have been set
70 42         125 my $connheader = {
71             'rhost' => '', # The value of Reporting-MTA header or "Generating Server:"
72             };
73 42         78 my $v = undef;
74              
75 42         554 for my $e ( split("\n", $emailsteak->[0]) ) {
76             # Read error messages and delivery status lines from the head of the email
77             # to the previous line of the beginning of the original message.
78 1138 100       1611 unless( $readcursor ) {
79             # Beginning of the bounce message or message/delivery-status part
80 948 100       2471 $readcursor |= $indicators->{'deliverystatus'} if $e =~ $markingsof->{'message'};
81 948         1159 next;
82             }
83 190 50       404 next unless $readcursor & $indicators->{'deliverystatus'};
84              
85 190 100       395 if( $connvalues == scalar(keys %$connheader) ) {
86             # Diagnostic information for administrators:
87             #
88             # Generating server: mta2.neko.example.jp
89             #
90             # kijitora@example.jp
91             # #550 5.1.1 RESOLVER.ADR.RecipNotFound; not found ##
92             #
93             # Original message headers:
94 118         179 $v = $dscontents->[-1];
95              
96 118 100       621 if( $e =~ /\A([^ @]+[@][^ @]+)\z/ ) {
    100          
97             # kijitora@example.jp
98 36 50       149 if( $v->{'recipient'} ) {
99             # There are multiple recipient addresses in the message body.
100 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
101 0         0 $v = $dscontents->[-1];
102             }
103 36         105 $v->{'recipient'} = $1;
104 36         90 $recipients++;
105              
106             } elsif( $e =~ /([45]\d{2})[ ]([45][.]\d[.]\d+)[ ].+\z/ ) {
107             # #550 5.1.1 RESOLVER.ADR.RecipNotFound; not found ##
108             # #550 5.2.3 RESOLVER.RST.RecipSizeLimit; message too large for this recipient ##
109             # Remote Server returned '550 5.1.1 RESOLVER.ADR.RecipNotFound; not found'
110             # 3/09/2016 8:05:56 PM - Remote Server at mydomain.com (10.1.1.3) returned '550 4.4.7 QUEUE.Expired; message expired'
111 41         186 $v->{'replycode'} = int $1;
112 41         118 $v->{'status'} = $2;
113 41         103 $v->{'diagnosis'} = $e;
114              
115             } else {
116             # Continued line of error messages
117 41 50       127 next unless $v->{'diagnosis'};
118 0 0       0 next unless substr($v->{'diagnosis'}, -1, 1) eq '=';
119 0         0 substr($v->{'diagnosis'}, -1, 1, $e);
120             }
121             } else {
122             # Diagnostic information for administrators:
123             #
124             # Generating server: mta22.neko.example.org
125 72 100       453 next unless $e =~ $markingsof->{'rhost'};
126 36 50       130 next if $connheader->{'rhost'};
127 36         131 $connheader->{'rhost'} = $1;
128 36         83 $connvalues++;
129             }
130             }
131 42 100       224 return undef unless $recipients;
132              
133 36         104 for my $e ( @$dscontents ) {
134 36 100       404 if( $e->{'diagnosis'} =~ $markingsof->{'error'} ) {
135             # #550 5.1.1 RESOLVER.ADR.RecipNotFound; not found ##
136 26         84 my $f = $1;
137 26         153 for my $r ( keys %$ndrsubject ) {
138             # Try to match with error subject strings
139 118 100       214 next unless $f eq $r;
140 26         125 $e->{'reason'} = $ndrsubject->{ $r };
141 26         67 last;
142             }
143             }
144 36         309 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
145             }
146 36         249 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
147             }
148              
149             1;
150             __END__