File Coverage

lib/Sisimai/Lhost/Facebook.pm
Criterion Covered Total %
statement 70 75 93.3
branch 30 42 71.4
condition 4 7 57.1
subroutine 6 6 100.0
pod 2 2 100.0
total 112 132 84.8


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::Facebook;
2 14     14   6051 use parent 'Sisimai::Lhost';
  14         32  
  14         75  
3 14     14   857 use feature ':5.10';
  14         28  
  14         990  
4 14     14   85 use strict;
  14         25  
  14         289  
5 14     14   67 use warnings;
  14         25  
  14         13407  
6              
7 2     2 1 1184 sub description { 'Facebook: https://www.facebook.com' }
8             sub make {
9             # Detect an error from Facebook
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 193     193 1 729 my $class = shift;
16 193   100     543 my $mhead = shift // return undef;
17 192   50     520 my $mbody = shift // return undef;
18              
19 192 100       714 return undef unless $mhead->{'from'} eq 'Facebook ';
20 11 50       37 return undef unless $mhead->{'subject'} eq 'Sorry, your message could not be delivered';
21              
22 11         40 state $indicators = __PACKAGE__->INDICATORS;
23 11         31 state $rebackbone = qr|^Content-Disposition:[ ]inline|m;
24 11         26 state $startingof = { 'message' => ['This message was created automatically by Facebook.'] };
25 11         61 state $errorcodes = {
26             # http://postmaster.facebook.com/response_codes
27             # NOT TESTD EXCEPT RCP-P2
28             'userunknown' => [
29             'RCP-P1', # The attempted recipient address does not exist.
30             'INT-P1', # The attempted recipient address does not exist.
31             'INT-P3', # The attempted recpient group address does not exist.
32             'INT-P4', # The attempted recipient address does not exist.
33             ],
34             'filtered' => [
35             'RCP-P2', # The attempted recipient's preferences prevent messages from being delivered.
36             'RCP-P3', # The attempted recipient's privacy settings blocked the delivery.
37             ],
38             'blocked' => [
39             'POL-P1', # Your mail server's IP Address is listed on the Spamhaus PBL.
40             'POL-P2', # Facebook will no longer accept mail from your mail server's IP Address.
41             ],
42             'mesgtoobig' => [
43             'MSG-P1', # The message exceeds Facebook's maximum allowed size.
44             'INT-P2', # The message exceeds Facebook's maximum allowed size.
45             ],
46             'contenterror' => [
47             'MSG-P2', # The message contains an attachment type that Facebook does not accept.
48             'MSG-P3', # The message contains multiple instances of a header field that can only be present once.
49             'POL-P6', # The message contains a url that has been blocked by Facebook.
50             'POL-P7', # The message does not comply with Facebook's abuse policies and will not be accepted.
51             ],
52             'securityerror' => [
53             'POL-P7', # The message does not comply with Facebook's Domain Authentication requirements.
54             ],
55             'notaccept' => [
56             'POL-P3', # Facebook is not accepting messages from your mail server. This will persist for 4 to 8 hours.
57             'POL-P4', # Facebook is not accepting messages from your mail server. This will persist for 24 to 48 hours.
58             'POL-T1', # Facebook is not accepting messages from your mail server, but they may be retried later. This will persist for 1 to 2 hours.
59             'POL-T2', # Facebook is not accepting messages from your mail server, but they may be retried later. This will persist for 4 to 8 hours.
60             'POL-T3', # Facebook is not accepting messages from your mail server, but they may be retried later. This will persist for 24 to 48 hours.
61             ],
62             'rejected' => [
63             'DNS-P1', # Your SMTP MAIL FROM domain does not exist.
64             'DNS-P2', # Your SMTP MAIL FROM domain does not have an MX record.
65             'DNS-T1', # Your SMTP MAIL FROM domain exists but does not currently resolve.
66             'DNS-P3', # Your mail server does not have a reverse DNS record.
67             'DNS-T2', # You mail server's reverse DNS record does not currently resolve.
68             ],
69             'systemerror' => [
70             'CON-T1', # Facebook's mail server currently has too many connections open to allow another one.
71             'RCP-T1', # The attempted recipient address is not currently available due to an internal system issue. This is a temporary condition.
72             ],
73             'toomanyconn' => [
74             'CON-T2', # Your mail server currently has too many connections open to Facebook's mail servers.
75             'CON-T3', # Your mail server has opened too many new connections to Facebook's mail servers in a short period of time.
76             ],
77             'virusdetected' => [
78             'POL-P5', # The message contains a virus.
79             ],
80             'suspend' => [
81             'RCP-T4', # The attempted recipient address is currently deactivated. The user may or may not reactivate it.
82             ],
83             'undefined' => [
84             'MSG-T1', # The number of recipients on the message exceeds Facebook's allowed maximum.
85             'CON-T4', # Your mail server has exceeded the maximum number of recipients for its current connection.
86             ],
87             };
88              
89 11         448 require Sisimai::RFC1894;
90 11         61 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
91 11         17 my $permessage = {}; # (Hash) Store values of each Per-Message field
92              
93 11         52 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
94 11         64 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
95 11         16 my $readcursor = 0; # (Integer) Points the current cursor position
96 11         18 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
97 11         16 my $fbresponse = ''; # (String) Response code from Facebook
98 11         24 my $v = undef;
99 11         16 my $p = '';
100              
101 11         88 for my $e ( split("\n", $emailsteak->[0]) ) {
102             # Read error messages and delivery status lines from the head of the email
103             # to the previous line of the beginning of the original message.
104 192 100       275 unless( $readcursor ) {
105             # Beginning of the bounce message or message/delivery-status part
106 22 100       99 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
107 22         29 next;
108             }
109 170 50       276 next unless $readcursor & $indicators->{'deliverystatus'};
110 170 100       245 next unless length $e;
111              
112 126 100       357 if( my $f = Sisimai::RFC1894->match($e) ) {
113             # $e matched with any field defined in RFC3464
114 77 50       141 next unless my $o = Sisimai::RFC1894->field($e);
115 77         110 $v = $dscontents->[-1];
116              
117 77 100       170 if( $o->[-1] eq 'addr' ) {
    100          
118             # Final-Recipient: rfc822; kijitora@example.jp
119             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
120 11 50       35 if( $o->[0] eq 'final-recipient' ) {
121             # Final-Recipient: rfc822; kijitora@example.jp
122 11 50       46 if( $v->{'recipient'} ) {
123             # There are multiple recipient addresses in the message body.
124 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
125 0         0 $v = $dscontents->[-1];
126             }
127 11         24 $v->{'recipient'} = $o->[2];
128 11         27 $recipients++;
129              
130             } else {
131             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
132 0         0 $v->{'alias'} = $o->[2];
133             }
134             } elsif( $o->[-1] eq 'code' ) {
135             # Diagnostic-Code: SMTP; 550 5.1.1 ... User Unknown
136 11         28 $v->{'spec'} = $o->[1];
137 11         31 $v->{'diagnosis'} = $o->[2];
138              
139             } else {
140             # Other DSN fields defined in RFC3464
141 55 50       118 next unless exists $fieldtable->{ $o->[0] };
142 55         114 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
143              
144 55 100       120 next unless $f == 1;
145 22         69 $permessage->{ $fieldtable->{ $o->[0] } } = $o->[2];
146             }
147             } else {
148             # Continued line of the value of Diagnostic-Code field
149 49 100       116 next unless index($p, 'Diagnostic-Code:') == 0;
150 5 50       29 next unless $e =~ /\A[ \t]+(.+)\z/;
151 5         22 $v->{'diagnosis'} .= ' '.$1;
152             }
153             } continue {
154             # Save the current line for the next loop
155 192         286 $p = $e;
156             }
157 11 50       52 return undef unless $recipients;
158              
159 11         25 for my $e ( @$dscontents ) {
160 11   33     68 $e->{'lhost'} ||= $permessage->{'lhost'};
161 11         77 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
162              
163 11 50       79 if( $e->{'diagnosis'} =~ /\b([A-Z]{3})[-]([A-Z])(\d)\b/ ) {
164             # Diagnostic-Code: smtp; 550 5.1.1 RCP-P2
165 11         81 $fbresponse = sprintf("%s-%s%d", $1, $2, $3);
166             }
167              
168 11         75 SESSION: for my $r ( keys %$errorcodes ) {
169             # Verify each regular expression of session errors
170 63         68 PATTERN: for my $rr ( @{ $errorcodes->{ $r } } ) {
  63         99  
171             # Check each regular expression
172 142 100       263 next(PATTERN) unless $fbresponse eq $rr;
173 11         17 $e->{'reason'} = $r;
174 11         30 last(SESSION);
175             }
176             }
177 11 50       48 next if $e->{'reason'};
178              
179             # http://postmaster.facebook.com/response_codes
180             # Facebook System Resource Issues
181             # These codes indicate a temporary issue internal to Facebook's
182             # system. Administrators observing these issues are not required to
183             # take any action to correct them.
184             #
185             # * INT-Tx
186             #
187             # https://groups.google.com/forum/#!topic/cdmix/eXfi4ddgYLQ
188             # This block has not been tested because we have no email sample
189             # including "INT-T?" error code.
190 0 0       0 next unless $fbresponse =~ /\AINT-T\d+\z/;
191 0         0 $e->{'reason'} = 'systemerror';
192             }
193 11         83 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
194             }
195              
196             1;
197             __END__