line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sisimai::RFC1894; |
2
|
53
|
|
|
53
|
|
69909
|
use feature ':5.10'; |
|
53
|
|
|
|
|
102
|
|
|
53
|
|
|
|
|
4124
|
|
3
|
53
|
|
|
53
|
|
290
|
use strict; |
|
53
|
|
|
|
|
90
|
|
|
53
|
|
|
|
|
985
|
|
4
|
53
|
|
|
53
|
|
233
|
use warnings; |
|
53
|
|
|
|
|
84
|
|
|
53
|
|
|
|
|
44833
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
sub FIELDTABLE { |
7
|
|
|
|
|
|
|
# Return pairs that a field name and key name defined in Sisimai::Lhost class |
8
|
|
|
|
|
|
|
return { |
9
|
1947
|
|
|
1947
|
0
|
17615
|
'action' => 'action', |
10
|
|
|
|
|
|
|
'arrival-date' => 'date', |
11
|
|
|
|
|
|
|
'diagnostic-code' => 'diagnosis', |
12
|
|
|
|
|
|
|
'final-recipient' => 'recipient', |
13
|
|
|
|
|
|
|
'last-attempt-date' => 'date', |
14
|
|
|
|
|
|
|
'original-recipient'=> 'alias', |
15
|
|
|
|
|
|
|
'received-from-mta' => 'lhost', |
16
|
|
|
|
|
|
|
'remote-mta' => 'rhost', |
17
|
|
|
|
|
|
|
'reporting-mta' => 'rhost', |
18
|
|
|
|
|
|
|
'status' => 'status', |
19
|
|
|
|
|
|
|
'x-actual-recipient'=> 'alias', |
20
|
|
|
|
|
|
|
}; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub match { |
24
|
|
|
|
|
|
|
# Check the argument matches with a field defined in RFC3464 |
25
|
|
|
|
|
|
|
# @param [String] argv0 A line inlcuding field and value defined in RFC3464 |
26
|
|
|
|
|
|
|
# @return [Integer] 0: did not matched, 1,2: matched |
27
|
|
|
|
|
|
|
# @since v4.25.0 |
28
|
30398
|
|
|
30398
|
1
|
57769
|
my $class = shift; |
29
|
30398
|
|
100
|
|
|
42204
|
my $argv0 = shift || return undef; |
30
|
|
|
|
|
|
|
|
31
|
30029
|
|
|
|
|
27812
|
state $fieldnames = [ |
32
|
|
|
|
|
|
|
# https://tools.ietf.org/html/rfc3464#section-2.2 |
33
|
|
|
|
|
|
|
# Some fields of a DSN apply to all of the delivery attempts described by |
34
|
|
|
|
|
|
|
# that DSN. At most, these fields may appear once in any DSN. These fields |
35
|
|
|
|
|
|
|
# are used to correlate the DSN with the original message transaction and |
36
|
|
|
|
|
|
|
# to provide additional information which may be useful to gateways. |
37
|
|
|
|
|
|
|
# |
38
|
|
|
|
|
|
|
# The following fields (not defined in RFC 3464) are used in Sisimai |
39
|
|
|
|
|
|
|
# - X-Original-Message-ID: <....> (GSuite) |
40
|
|
|
|
|
|
|
# |
41
|
|
|
|
|
|
|
# The following fields are not used in Sisimai: |
42
|
|
|
|
|
|
|
# - Original-Envelope-Id |
43
|
|
|
|
|
|
|
# - DSN-Gateway |
44
|
|
|
|
|
|
|
[qw|Reporting-MTA Received-From-MTA Arrival-Date X-Original-Message-ID|], |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# https://tools.ietf.org/html/rfc3464#section-2.3 |
47
|
|
|
|
|
|
|
# A DSN contains information about attempts to deliver a message to one or |
48
|
|
|
|
|
|
|
# more recipients. The delivery information for any particular recipient is |
49
|
|
|
|
|
|
|
# contained in a group of contiguous per-recipient fields. |
50
|
|
|
|
|
|
|
# Each group of per-recipient fields is preceded by a blank line. |
51
|
|
|
|
|
|
|
# |
52
|
|
|
|
|
|
|
# The following fields (not defined in RFC 3464) are used in Sisimai |
53
|
|
|
|
|
|
|
# - X-Actual-Recipient: RFC822; .... |
54
|
|
|
|
|
|
|
# |
55
|
|
|
|
|
|
|
# The following fields are not used in Sisimai: |
56
|
|
|
|
|
|
|
# - Will-Retry-Until |
57
|
|
|
|
|
|
|
# - Final-Log-ID |
58
|
|
|
|
|
|
|
[qw|Original-Recipient Final-Recipient Action Status Remote-MTA |
59
|
|
|
|
|
|
|
Diagnostic-Code Last-Attempt-Date X-Actual-Recipient|], |
60
|
|
|
|
|
|
|
]; |
61
|
|
|
|
|
|
|
|
62
|
30029
|
100
|
|
|
|
29369
|
return 1 if grep { index($argv0, $_) == 0 } @{ $fieldnames->[0] }; |
|
120116
|
|
|
|
|
203873
|
|
|
30029
|
|
|
|
|
42960
|
|
63
|
26685
|
100
|
|
|
|
27789
|
return 2 if grep { index($argv0, $_) == 0 } @{ $fieldnames->[1] }; |
|
213480
|
|
|
|
|
300920
|
|
|
26685
|
|
|
|
|
32623
|
|
64
|
18614
|
|
|
|
|
37730
|
return 0; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub field { |
68
|
|
|
|
|
|
|
# Check the argument is including field defined in RFC3464 and return values |
69
|
|
|
|
|
|
|
# @param [String] argv0 A line inlcuding field and value defined in RFC3464 |
70
|
|
|
|
|
|
|
# @return [Array] ['field-name', 'value-type', 'Value', 'field-group'] |
71
|
|
|
|
|
|
|
# @since v4.25.0 |
72
|
11419
|
|
|
11419
|
1
|
13465
|
my $class = shift; |
73
|
11419
|
|
50
|
|
|
16601
|
my $argv0 = shift || return undef; |
74
|
|
|
|
|
|
|
|
75
|
11419
|
|
|
|
|
12048
|
state $correction = { |
76
|
|
|
|
|
|
|
'action' => { 'deliverable' => 'delivered', 'expired' => 'delayed', 'failure' => 'failed' }, |
77
|
|
|
|
|
|
|
}; |
78
|
11419
|
|
|
|
|
11685
|
state $fieldgroup = { |
79
|
|
|
|
|
|
|
'original-recipient' => 'addr', |
80
|
|
|
|
|
|
|
'final-recipient' => 'addr', |
81
|
|
|
|
|
|
|
'x-actual-recipient' => 'addr', |
82
|
|
|
|
|
|
|
'diagnostic-code' => 'code', |
83
|
|
|
|
|
|
|
'arrival-date' => 'date', |
84
|
|
|
|
|
|
|
'last-attempt-date' => 'date', |
85
|
|
|
|
|
|
|
'received-from-mta' => 'host', |
86
|
|
|
|
|
|
|
'remote-mta' => 'host', |
87
|
|
|
|
|
|
|
'reporting-mta' => 'host', |
88
|
|
|
|
|
|
|
'action' => 'list', |
89
|
|
|
|
|
|
|
'status' => 'stat', |
90
|
|
|
|
|
|
|
'x-original-message-id' => 'text', |
91
|
|
|
|
|
|
|
}; |
92
|
11419
|
|
|
|
|
11403
|
state $captureson = { |
93
|
|
|
|
|
|
|
'addr' => qr/\A((?:Original|Final|X-Actual)-Recipient):[ ]*(.+?);[ ]*(.+)/, |
94
|
|
|
|
|
|
|
'code' => qr/\A(Diagnostic-Code):[ ]*(.+?);[ ]*(.*)/, |
95
|
|
|
|
|
|
|
'date' => qr/\A((?:Arrival|Last-Attempt)-Date):[ ]*(.+)/, |
96
|
|
|
|
|
|
|
'host' => qr/\A((?:Received-From|Remote|Reporting)-MTA):[ ]*(.+?);[ ]*(.+)/, |
97
|
|
|
|
|
|
|
'list' => qr/\A(Action):[ ]*(delayed|deliverable|delivered|expanded|expired|failed|failure|relayed)/i, |
98
|
|
|
|
|
|
|
'stat' => qr/\A(Status):[ ]*([245][.]\d+[.]\d+)/, |
99
|
|
|
|
|
|
|
'text' => qr/\A(X-Original-Message-ID):[ ]*(.+)/, |
100
|
|
|
|
|
|
|
#'text' => qr/\A(Final-Log-ID|Original-Envelope-Id):[ ]*(.+)/, |
101
|
|
|
|
|
|
|
}; |
102
|
|
|
|
|
|
|
|
103
|
11419
|
|
100
|
|
|
37534
|
my $group = $fieldgroup->{ lc((split(':', $argv0, 2))[0]) } || return undef; |
104
|
11415
|
50
|
|
|
|
23606
|
return undef unless exists $captureson->{ $group }; |
105
|
|
|
|
|
|
|
|
106
|
11415
|
|
|
|
|
20872
|
my $table = ['', '', '', '']; |
107
|
11415
|
|
|
|
|
12631
|
my $match = 0; |
108
|
11415
|
|
|
|
|
70430
|
while( $argv0 =~ $captureson->{ $group } ) { |
109
|
|
|
|
|
|
|
# Try to match with each pattern of Per-Message field, Per-Recipient field |
110
|
|
|
|
|
|
|
# - 0: Field-Name |
111
|
|
|
|
|
|
|
# - 1: Sub Type: RFC822, DNS, X-Unix, and so on) |
112
|
|
|
|
|
|
|
# - 2: Value |
113
|
|
|
|
|
|
|
# - 3: Field Group(addr, code, date, host, stat, text) |
114
|
11342
|
|
|
|
|
15617
|
$match = 1; |
115
|
11342
|
|
|
|
|
25074
|
$table->[0] = lc $1; |
116
|
11342
|
|
|
|
|
13254
|
$table->[3] = $group; |
117
|
|
|
|
|
|
|
|
118
|
11342
|
100
|
100
|
|
|
42608
|
if( $group eq 'addr' || $group eq 'code' || $group eq 'host' ) { |
|
|
|
100
|
|
|
|
|
119
|
|
|
|
|
|
|
# - Final-Recipient: RFC822; kijitora@nyaan.jp |
120
|
|
|
|
|
|
|
# - Diagnostic-Code: SMTP; 550 5.1.1 ... User Unknown |
121
|
|
|
|
|
|
|
# - Remote-MTA: DNS; mx.example.jp |
122
|
6389
|
|
|
|
|
12656
|
$table->[1] = uc $2; |
123
|
6389
|
100
|
|
|
|
14299
|
$table->[2] = $group eq 'host' ? lc $3 : $3; |
124
|
6389
|
100
|
|
|
|
16604
|
$table->[2] = '' if $table->[2] =~ /\A\s+\z/; # Remote-MTA: dns; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
} else { |
127
|
|
|
|
|
|
|
# - Action: failed |
128
|
|
|
|
|
|
|
# - Status: 5.2.2 |
129
|
4953
|
|
|
|
|
6641
|
$table->[1] = ''; |
130
|
4953
|
100
|
|
|
|
11160
|
$table->[2] = $group eq 'date' ? $2 : lc $2; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# Correct invalid value in Action field: |
133
|
4953
|
100
|
|
|
|
9299
|
last unless $group eq 'list'; |
134
|
1506
|
100
|
|
|
|
4031
|
last unless exists $correction->{'action'}->{ $table->[2] }; |
135
|
5
|
|
|
|
|
28
|
$table->[2] = $correction->{'action'}->{ $table->[2] }; |
136
|
|
|
|
|
|
|
} |
137
|
6394
|
|
|
|
|
7443
|
last; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
11415
|
100
|
|
|
|
16416
|
return undef unless $match; |
141
|
11342
|
|
|
|
|
27054
|
return $table; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
1; |
145
|
|
|
|
|
|
|
__END__ |