line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sisimai::Lhost::GSuite; |
2
|
26
|
|
|
26
|
|
6105
|
use parent 'Sisimai::Lhost'; |
|
26
|
|
|
|
|
48
|
|
|
26
|
|
|
|
|
143
|
|
3
|
26
|
|
|
26
|
|
1698
|
use feature ':5.10'; |
|
26
|
|
|
|
|
46
|
|
|
26
|
|
|
|
|
1910
|
|
4
|
26
|
|
|
26
|
|
142
|
use strict; |
|
26
|
|
|
|
|
163
|
|
|
26
|
|
|
|
|
642
|
|
5
|
26
|
|
|
26
|
|
123
|
use warnings; |
|
26
|
|
|
|
|
70
|
|
|
26
|
|
|
|
|
35367
|
|
6
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
1
|
1168
|
sub description { 'G Suite: https://gsuite.google.com/' } |
8
|
|
|
|
|
|
|
sub make { |
9
|
|
|
|
|
|
|
# Detect an error from G Suite (Transfer from G Suite to a destination host) |
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.21.0 |
15
|
689
|
|
|
689
|
1
|
1542
|
my $class = shift; |
16
|
689
|
|
100
|
|
|
1789
|
my $mhead = shift // return undef; |
17
|
688
|
|
50
|
|
|
1746
|
my $mbody = shift // return undef; |
18
|
|
|
|
|
|
|
|
19
|
688
|
100
|
|
|
|
2513
|
return undef unless rindex($mhead->{'from'}, '') > -1; |
20
|
219
|
50
|
|
|
|
899
|
return undef unless index($mhead->{'subject'}, 'Delivery Status Notification') > -1; |
21
|
219
|
100
|
|
|
|
681
|
return undef unless $mhead->{'x-gm-message-state'}; |
22
|
|
|
|
|
|
|
|
23
|
163
|
|
|
|
|
371
|
state $indicators = __PACKAGE__->INDICATORS; |
24
|
163
|
|
|
|
|
326
|
state $rebackbone = qr<^Content-Type:[ ](?:message/rfc822|text/rfc822-headers)>m; |
25
|
163
|
|
|
|
|
327
|
state $markingsof = { |
26
|
|
|
|
|
|
|
'message' => qr/\A[*][*][ ].+[ ][*][*]\z/, |
27
|
|
|
|
|
|
|
'error' => qr/\AThe[ ]response([ ]from[ ]the[ ]remote[ ]server)?[ ]was:\z/, |
28
|
|
|
|
|
|
|
'html' => qr{\AContent-Type:[ ]*text/html;[ ]*charset=['"]?(?:UTF|utf)[-]8['"]?\z}, |
29
|
|
|
|
|
|
|
}; |
30
|
163
|
|
|
|
|
294
|
state $messagesof = { |
31
|
|
|
|
|
|
|
'userunknown' => ["because the address couldn't be found. Check for typos or unnecessary spaces and try again."], |
32
|
|
|
|
|
|
|
'notaccept' => ['Null MX'], |
33
|
|
|
|
|
|
|
'networkerror' => [' had no relevant answers.', ' responded with code NXDOMAIN'], |
34
|
|
|
|
|
|
|
}; |
35
|
|
|
|
|
|
|
|
36
|
163
|
|
|
|
|
1991
|
require Sisimai::RFC1894; |
37
|
163
|
|
|
|
|
869
|
my $fieldtable = Sisimai::RFC1894->FIELDTABLE; |
38
|
163
|
|
|
|
|
344
|
my $permessage = {}; # (Hash) Store values of each Per-Message field |
39
|
|
|
|
|
|
|
|
40
|
163
|
|
|
|
|
1053
|
my $dscontents = [__PACKAGE__->DELIVERYSTATUS]; |
41
|
163
|
|
|
|
|
912
|
my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone); |
42
|
163
|
|
|
|
|
654
|
my $readcursor = 0; # (Integer) Points the current cursor position |
43
|
163
|
|
|
|
|
552
|
my $recipients = 0; # (Integer) The number of 'Final-Recipient' header |
44
|
163
|
|
|
|
|
267
|
my $endoferror = 0; # (Integer) Flag for a blank line after error messages |
45
|
163
|
|
|
|
|
229
|
my $emptylines = 0; # (Integer) The number of empty lines |
46
|
163
|
|
|
|
|
345
|
my $anotherset = { # (Hash) Another error information |
47
|
|
|
|
|
|
|
'diagnosis' => '', |
48
|
|
|
|
|
|
|
}; |
49
|
163
|
|
|
|
|
263
|
my $v = undef; |
50
|
|
|
|
|
|
|
|
51
|
163
|
|
|
|
|
2698
|
for my $e ( split("\n", $emailsteak->[0]) ) { |
52
|
|
|
|
|
|
|
# Read error messages and delivery status lines from the head of the email |
53
|
|
|
|
|
|
|
# to the previous line of the beginning of the original message. |
54
|
7247
|
100
|
|
|
|
10020
|
unless( $readcursor ) { |
55
|
|
|
|
|
|
|
# Beginning of the bounce message or message/delivery-status part |
56
|
5789
|
100
|
|
|
|
12800
|
$readcursor |= $indicators->{'deliverystatus'} if $e =~ $markingsof->{'message'}; |
57
|
|
|
|
|
|
|
} |
58
|
7247
|
100
|
|
|
|
12052
|
next unless $readcursor & $indicators->{'deliverystatus'}; |
59
|
|
|
|
|
|
|
|
60
|
1529
|
100
|
|
|
|
2696
|
if( my $f = Sisimai::RFC1894->match($e) ) { |
61
|
|
|
|
|
|
|
# $e matched with any field defined in RFC3464 |
62
|
610
|
50
|
|
|
|
1228
|
next unless my $o = Sisimai::RFC1894->field($e); |
63
|
610
|
|
|
|
|
878
|
$v = $dscontents->[-1]; |
64
|
|
|
|
|
|
|
|
65
|
610
|
100
|
|
|
|
1268
|
if( $o->[-1] eq 'addr' ) { |
|
|
100
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# Final-Recipient: rfc822; kijitora@example.jp |
67
|
|
|
|
|
|
|
# X-Actual-Recipient: rfc822; kijitora@example.co.jp |
68
|
71
|
50
|
|
|
|
229
|
if( $o->[0] eq 'final-recipient' ) { |
69
|
|
|
|
|
|
|
# Final-Recipient: rfc822; kijitora@example.jp |
70
|
71
|
50
|
|
|
|
220
|
if( $v->{'recipient'} ) { |
71
|
|
|
|
|
|
|
# There are multiple recipient addresses in the message body. |
72
|
0
|
|
|
|
|
0
|
push @$dscontents, __PACKAGE__->DELIVERYSTATUS; |
73
|
0
|
|
|
|
|
0
|
$v = $dscontents->[-1]; |
74
|
|
|
|
|
|
|
} |
75
|
71
|
|
|
|
|
156
|
$v->{'recipient'} = $o->[2]; |
76
|
71
|
|
|
|
|
195
|
$recipients++; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
} else { |
79
|
|
|
|
|
|
|
# X-Actual-Recipient: rfc822; kijitora@example.co.jp |
80
|
0
|
|
|
|
|
0
|
$v->{'alias'} = $o->[2]; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
} elsif( $o->[-1] eq 'code' ) { |
83
|
|
|
|
|
|
|
# Diagnostic-Code: SMTP; 550 5.1.1 ... User Unknown |
84
|
66
|
|
|
|
|
184
|
$v->{'spec'} = $o->[1]; |
85
|
66
|
|
|
|
|
188
|
$v->{'diagnosis'} = $o->[2]; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
} else { |
88
|
|
|
|
|
|
|
# Other DSN fields defined in RFC3464 |
89
|
473
|
100
|
|
|
|
1171
|
next unless exists $fieldtable->{ $o->[0] }; |
90
|
402
|
|
|
|
|
797
|
$v->{ $fieldtable->{ $o->[0] } } = $o->[2]; |
91
|
|
|
|
|
|
|
|
92
|
402
|
100
|
|
|
|
837
|
if( $fieldtable->{ $o->[0] } eq 'lhost' ) { |
93
|
|
|
|
|
|
|
# Do not set an email address as a hostname in "lhost" value |
94
|
21
|
50
|
|
|
|
119
|
$v->{'lhost'} = '' if index($v->{'lhost'}, '@'); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
402
|
100
|
|
|
|
876
|
next unless $f == 1; |
98
|
163
|
|
|
|
|
588
|
$permessage->{ $fieldtable->{ $o->[0] } } = $o->[2]; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} else { |
101
|
|
|
|
|
|
|
# The line does not begin with a DSN field defined in RFC3464 |
102
|
919
|
100
|
66
|
|
|
4185
|
if( ! $endoferror && $v->{'diagnosis'} ) { |
|
|
100
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# Append error messages continued from the previous line |
104
|
90
|
50
|
0
|
|
|
201
|
$endoferror ||= 1 if $e eq ''; |
105
|
90
|
50
|
|
|
|
152
|
next if $endoferror; |
106
|
90
|
|
|
|
|
237
|
$v->{'diagnosis'} .= $e; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
} elsif( $e =~ $markingsof->{'error'} ) { |
109
|
|
|
|
|
|
|
# The response from the remote server was: |
110
|
66
|
|
|
|
|
214
|
$anotherset->{'diagnosis'} .= $e; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
} else { |
113
|
|
|
|
|
|
|
# ** Address not found ** |
114
|
|
|
|
|
|
|
# |
115
|
|
|
|
|
|
|
# Your message wasn't delivered to * because the address couldn't be found. |
116
|
|
|
|
|
|
|
# Check for typos or unnecessary spaces and try again. |
117
|
|
|
|
|
|
|
# |
118
|
|
|
|
|
|
|
# The response from the remote server was: |
119
|
|
|
|
|
|
|
# 550 #5.1.0 Address rejected. |
120
|
763
|
100
|
|
|
|
1595
|
next if $e =~ /\AContent-Type:/; |
121
|
692
|
100
|
|
|
|
977
|
if( $anotherset->{'diagnosis'} ) { |
122
|
|
|
|
|
|
|
# Continued error messages from the previous line like |
123
|
|
|
|
|
|
|
# "550 #5.1.0 Address rejected." |
124
|
621
|
100
|
|
|
|
1031
|
next if $emptylines > 5; |
125
|
606
|
100
|
|
|
|
992
|
unless( length $e ) { |
126
|
|
|
|
|
|
|
# Count and next() |
127
|
359
|
|
|
|
|
431
|
$emptylines += 1; |
128
|
359
|
|
|
|
|
578
|
next; |
129
|
|
|
|
|
|
|
} |
130
|
247
|
|
|
|
|
749
|
$anotherset->{'diagnosis'} .= ' '.$e |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
} else { |
133
|
|
|
|
|
|
|
# ** Address not found ** |
134
|
|
|
|
|
|
|
# |
135
|
|
|
|
|
|
|
# Your message wasn't delivered to * because the address couldn't be found. |
136
|
|
|
|
|
|
|
# Check for typos or unnecessary spaces and try again. |
137
|
71
|
50
|
|
|
|
438
|
next unless $e =~ $markingsof->{'message'}; |
138
|
71
|
|
|
|
|
256
|
$anotherset->{'diagnosis'} = $e; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} # End of message/delivery-status |
142
|
|
|
|
|
|
|
} |
143
|
163
|
100
|
|
|
|
1671
|
return undef unless $recipients; |
144
|
|
|
|
|
|
|
|
145
|
71
|
|
|
|
|
211
|
for my $e ( @$dscontents ) { |
146
|
|
|
|
|
|
|
# Set default values if each value is empty. |
147
|
71
|
|
33
|
|
|
428
|
$e->{'lhost'} ||= $permessage->{'rhost'}; |
148
|
71
|
|
0
|
|
|
852
|
$e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage; |
|
|
|
33
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
71
|
50
|
33
|
|
|
371
|
if( exists $anotherset->{'diagnosis'} && $anotherset->{'diagnosis'} ) { |
151
|
|
|
|
|
|
|
# Copy alternative error message |
152
|
71
|
|
66
|
|
|
194
|
$e->{'diagnosis'} ||= $anotherset->{'diagnosis'}; |
153
|
71
|
50
|
|
|
|
357
|
if( $e->{'diagnosis'} =~ /\A\d+\z/ ) { |
154
|
|
|
|
|
|
|
# Override the value of diagnostic code message |
155
|
0
|
|
|
|
|
0
|
$e->{'diagnosis'} = $anotherset->{'diagnosis'}; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
} else { |
158
|
|
|
|
|
|
|
# More detailed error message is in "$anotherset" |
159
|
71
|
|
|
|
|
148
|
my $as = undef; # status |
160
|
71
|
|
|
|
|
111
|
my $ar = undef; # replycode |
161
|
|
|
|
|
|
|
|
162
|
71
|
100
|
66
|
|
|
571
|
if( $e->{'status'} eq '' || $e->{'status'} eq '5.0.0' || $e->{'status'} eq '4.0.0' ) { |
|
|
|
100
|
|
|
|
|
163
|
|
|
|
|
|
|
# Check the value of D.S.N. in $anotherset |
164
|
51
|
|
100
|
|
|
364
|
$as = Sisimai::SMTP::Status->find($anotherset->{'diagnosis'}) || ''; |
165
|
51
|
100
|
66
|
|
|
242
|
if( length($as) > 0 && substr($as, -4, 4) ne '.0.0' ) { |
166
|
|
|
|
|
|
|
# The D.S.N. is neither an empty nor *.0.0 |
167
|
6
|
|
|
|
|
19
|
$e->{'status'} = $as; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
71
|
0
|
33
|
|
|
284
|
if( $e->{'replycode'} eq '' || $e->{'replycode'} eq '500' || $e->{'replycode'} eq '400' ) { |
|
|
|
33
|
|
|
|
|
172
|
|
|
|
|
|
|
# Check the value of SMTP reply code in $anotherset |
173
|
71
|
|
100
|
|
|
390
|
$ar = Sisimai::SMTP::Reply->find($anotherset->{'diagnosis'}) || ''; |
174
|
71
|
100
|
66
|
|
|
368
|
if( length($ar) > 0 && substr($ar, -2, 2) ne '00' ) { |
175
|
|
|
|
|
|
|
# The SMTP reply code is neither an empty nor *00 |
176
|
26
|
|
|
|
|
85
|
$e->{'replycode'} = $ar; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
71
|
100
|
66
|
|
|
462
|
if( $as || $ar && ( length($anotherset->{'diagnosis'}) > length($e->{'diagnosis'}) ) ) { |
|
|
|
100
|
|
|
|
|
181
|
|
|
|
|
|
|
# Update the error message in $e->{'diagnosis'} |
182
|
26
|
|
|
|
|
91
|
$e->{'diagnosis'} = $anotherset->{'diagnosis'}; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
} |
186
|
71
|
|
|
|
|
414
|
$e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'}); |
187
|
|
|
|
|
|
|
|
188
|
71
|
|
|
|
|
368
|
for my $q ( keys %$messagesof ) { |
189
|
|
|
|
|
|
|
# Guess an reason of the bounce |
190
|
177
|
100
|
|
|
|
280
|
next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $messagesof->{ $q } }; |
|
237
|
|
|
|
|
1013
|
|
|
177
|
|
|
|
|
331
|
|
191
|
36
|
|
|
|
|
77
|
$e->{'reason'} = $q; |
192
|
36
|
|
|
|
|
84
|
last; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
} |
195
|
71
|
|
|
|
|
675
|
return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] }; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
1; |
199
|
|
|
|
|
|
|
__END__ |