File Coverage

lib/Sisimai/Lhost/MessagingServer.pm
Criterion Covered Total %
statement 69 70 98.5
branch 39 44 88.6
condition 8 17 47.0
subroutine 6 6 100.0
pod 2 2 100.0
total 124 139 89.2


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::MessagingServer;
2 16     16   5352 use parent 'Sisimai::Lhost';
  16         27  
  16         79  
3 16     16   835 use feature ':5.10';
  16         26  
  16         953  
4 16     16   92 use strict;
  16         23  
  16         282  
5 16     16   64 use warnings;
  16         24  
  16         16364  
6              
7 2     2 1 1058 sub description { 'Oracle Communications Messaging Server' }
8             sub make {
9             # Detect an error from Oracle Communications Messaging Server
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.3
15 253     253 1 677 my $class = shift;
16 253   100     624 my $mhead = shift // return undef;
17 252   50     579 my $mbody = shift // return undef;
18 252         326 my $match = 0;
19              
20             # 'received' => qr/[ ][(]MessagingServer[)][ ]with[ ]/,
21 252 100 50     948 $match ||= 1 if rindex($mhead->{'content-type'}, 'Boundary_(ID_') > -1;
22 252 100 50     803 $match ||= 1 if index($mhead->{'subject'}, 'Delivery Notification: ') == 0;
23 252 100       585 return undef unless $match;
24              
25 61         143 state $indicators = __PACKAGE__->INDICATORS;
26 61         93 state $rebackbone = qr<^(?:Content-type:[ \t]*message/rfc822|Return-path:[ \t]*)>m;
27 61         167 state $startingof = { 'message' => ['This report relates to a message you sent with the following header fields:'] };
28 61         91 state $messagesof = { 'hostunknown' => ['Illegal host/domain name found'] };
29              
30 61         218 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
31 61         337 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
32 61         132 my $readcursor = 0; # (Integer) Points the current cursor position
33 61         108 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
34 61         110 my $v = undef;
35              
36 61         620 for my $e ( split("\n", $emailsteak->[0]) ) {
37             # Read error messages and delivery status lines from the head of the email
38             # to the previous line of the beginning of the original message.
39 1915 100       2298 unless( $readcursor ) {
40             # Beginning of the bounce message or message/delivery-status part
41 117 100       434 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
42 117         197 next;
43             }
44 1798 50       2183 next unless $readcursor & $indicators->{'deliverystatus'};
45 1798 100       2129 next unless length $e;
46              
47             # --Boundary_(ID_0000000000000000000000)
48             # Content-type: text/plain; charset=us-ascii
49             # Content-language: en-US
50             #
51             # This report relates to a message you sent with the following header fields:
52             #
53             # Message-id:
54             # Date: Fri, 21 Nov 2014 23:34:45 +0900
55             # From: Shironeko
56             # To: kijitora@example.jp
57             # Subject: Nyaaaaaaaaaaaaaaaaaaaaaan
58             #
59             # Your message cannot be delivered to the following recipients:
60             #
61             # Recipient address: kijitora@example.jp
62             # Reason: Remote SMTP server has rejected address
63             # Diagnostic code: smtp;550 5.1.1 ... User Unknown
64             # Remote system: dns;mx.example.jp (TCP|17.111.174.67|47323|192.0.2.225|25) (6jo.example.jp ESMTP SENDMAIL-VM)
65 1382         1272 $v = $dscontents->[-1];
66              
67 1382 100       4742 if( $e =~ /\A[ \t]+Recipient address:[ \t]*([^ ]+[@][^ ]+)\z/ ) {
    100          
    100          
    100          
    100          
    100          
68             # Recipient address: kijitora@example.jp
69 66 100       174 if( $v->{'recipient'} ) {
70             # There are multiple recipient addresses in the message body.
71 5         19 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
72 5         9 $v = $dscontents->[-1];
73             }
74 66         368 $v->{'recipient'} = Sisimai::Address->s3s4($1);
75 66         126 $recipients++;
76              
77             } elsif( $e =~ /\A[ \t]+Original address:[ \t]*([^ ]+[@][^ ]+)\z/ ) {
78             # Original address: kijitora@example.jp
79 5         20 $v->{'recipient'} = Sisimai::Address->s3s4($1);
80              
81             } elsif( $e =~ /\A[ \t]+Date:[ \t]*(.+)\z/ ) {
82             # Date: Fri, 21 Nov 2014 23:34:45 +0900
83 61         204 $v->{'date'} = $1;
84              
85             } elsif( $e =~ /\A[ \t]+Reason:[ \t]*(.+)\z/ ) {
86             # Reason: Remote SMTP server has rejected address
87 66         205 $v->{'diagnosis'} = $1;
88              
89             } elsif( $e =~ /\A[ \t]+Diagnostic code:[ \t]*([^ ]+);(.+)\z/ ) {
90             # Diagnostic code: smtp;550 5.1.1 ... User Unknown
91 46         140 $v->{'spec'} = uc $1;
92 46         96 $v->{'diagnosis'} = $2;
93              
94             } elsif( $e =~ /\A[ \t]+Remote system:[ \t]*dns;([^ ]+)[ \t]*([^ ]+)[ \t]*.+\z/ ) {
95             # Remote system: dns;mx.example.jp (TCP|17.111.174.67|47323|192.0.2.225|25)
96             # (6jo.example.jp ESMTP SENDMAIL-VM)
97 36         96 my $remotehost = $1; # remote host
98 36         59 my $sessionlog = $2; # smtp session
99 36         86 $v->{'rhost'} = $remotehost;
100              
101             # The value does not include ".", use IP address instead.
102             # (TCP|17.111.174.67|47323|192.0.2.225|25)
103 36 50       115 next unless $sessionlog =~ /\A[(]TCP|(.+)|\d+|(.+)|\d+[)]/;
104 36         85 $v->{'lhost'} = $1;
105 36 50       183 $v->{'rhost'} = $2 unless $remotehost =~ /[^.]+[.][^.]+/;
106              
107             } else {
108             # Original-envelope-id: 0NFC009FLKOUVMA0@mr21p30im-asmtp004.me.com
109             # Reporting-MTA: dns;mr21p30im-asmtp004.me.com (tcp-daemon)
110             # Arrival-date: Thu, 29 Apr 2014 23:34:45 +0000 (GMT)
111             #
112             # Original-recipient: rfc822;kijitora@example.jp
113             # Final-recipient: rfc822;kijitora@example.jp
114             # Action: failed
115             # Status: 5.1.1 (Remote SMTP server has rejected address)
116             # Remote-MTA: dns;mx.example.jp (TCP|17.111.174.67|47323|192.0.2.225|25)
117             # (6jo.example.jp ESMTP SENDMAIL-VM)
118             # Diagnostic-code: smtp;550 5.1.1 ... User Unknown
119             #
120 1102 100       2540 if( $e =~ /\AStatus:[ \t]*(\d[.]\d[.]\d)[ \t]*[(](.+)[)]\z/ ) {
    50          
    100          
121             # Status: 5.1.1 (Remote SMTP server has rejected address)
122 61         144 $v->{'status'} = $1;
123 61   33     123 $v->{'diagnosis'} ||= $2;
124              
125             } elsif( $e =~ /\AArrival-Date:[ ]*(.+)\z/ ) {
126             # Arrival-date: Thu, 29 Apr 2014 23:34:45 +0000 (GMT)
127 0   0     0 $v->{'date'} ||= $1;
128              
129             } elsif( $e =~ /\AReporting-MTA:[ ]*(?:DNS|dns);[ ]*(.+)\z/ ) {
130             # Reporting-MTA: dns;mr21p30im-asmtp004.me.com (tcp-daemon)
131 61         148 my $localhost = $1;
132 61   66     275 $v->{'lhost'} ||= $localhost;
133 61 100       283 $v->{'lhost'} = $localhost unless $v->{'lhost'} =~ /[^.]+[.][^ ]+/;
134             }
135             } # End of error message part
136             }
137 61 50       252 return undef unless $recipients;
138              
139 61         128 for my $e ( @$dscontents ) {
140 66         466 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
141              
142 66         233 SESSION: for my $r ( keys %$messagesof ) {
143             # Verify each regular expression of session errors
144 66 100       102 next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $messagesof->{ $r } };
  66         394  
  66         161  
145 5         11 $e->{'reason'} = $r;
146 5         14 last;
147             }
148             }
149 61         321 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
150             }
151              
152             1;
153             __END__