line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sisimai::Address; |
2
|
81
|
|
|
81
|
|
58124
|
use feature ':5.10'; |
|
81
|
|
|
|
|
150
|
|
|
81
|
|
|
|
|
5604
|
|
3
|
81
|
|
|
81
|
|
380
|
use strict; |
|
81
|
|
|
|
|
112
|
|
|
81
|
|
|
|
|
1294
|
|
4
|
81
|
|
|
81
|
|
299
|
use warnings; |
|
81
|
|
|
|
|
138
|
|
|
81
|
|
|
|
|
1721
|
|
5
|
81
|
|
|
81
|
|
6304
|
use Sisimai::RFC5322; |
|
81
|
|
|
|
|
118
|
|
|
81
|
|
|
|
|
2961
|
|
6
|
|
|
|
|
|
|
use Class::Accessor::Lite ( |
7
|
81
|
|
|
|
|
606
|
'new' => 0, |
8
|
|
|
|
|
|
|
'ro' => [ |
9
|
|
|
|
|
|
|
'address', # [String] Email address |
10
|
|
|
|
|
|
|
'user', # [String] local part of the email address |
11
|
|
|
|
|
|
|
'host', # [String] domain part of the email address |
12
|
|
|
|
|
|
|
'verp', # [String] VERP |
13
|
|
|
|
|
|
|
'alias', # [String] alias of the email address |
14
|
|
|
|
|
|
|
], |
15
|
|
|
|
|
|
|
'rw' => [ |
16
|
|
|
|
|
|
|
'name', # [String] Display name |
17
|
|
|
|
|
|
|
'comment', # [String] (Comment) |
18
|
|
|
|
|
|
|
] |
19
|
81
|
|
|
81
|
|
4860
|
); |
|
81
|
|
|
|
|
12094
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub undisclosed { |
22
|
|
|
|
|
|
|
# Return pseudo recipient or sender address |
23
|
|
|
|
|
|
|
# @param [String] atype Address type: 'r' or 's' |
24
|
|
|
|
|
|
|
# @return [String, Undef] Pseudo recipient address or sender address or |
25
|
|
|
|
|
|
|
# Undef when the $argv1 is neither 'r' nor 's' |
26
|
18
|
|
|
18
|
0
|
353
|
my $class = shift; |
27
|
18
|
|
100
|
|
|
50
|
my $atype = shift || return undef; |
28
|
|
|
|
|
|
|
|
29
|
17
|
50
|
|
|
|
71
|
return undef unless $atype =~ /\A(?:r|s)\z/; |
30
|
17
|
100
|
|
|
|
49
|
my $local = $atype eq 'r' ? 'recipient' : 'sender'; |
31
|
17
|
|
|
|
|
98
|
return sprintf("undisclosed-%s-in-headers%slibsisimai.org.invalid", $local, '@'); |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub new { |
35
|
|
|
|
|
|
|
# Old constructor of Sisimai::Address, wrapper method of make() |
36
|
|
|
|
|
|
|
# @param [String] email Email address |
37
|
|
|
|
|
|
|
# @return [Sisimai::Address, Undef] Object or Undef when the email |
38
|
|
|
|
|
|
|
# address was not valid. |
39
|
50
|
|
|
50
|
1
|
31229
|
my $class = shift; |
40
|
50
|
|
100
|
|
|
99
|
my $email = shift // return undef; |
41
|
49
|
|
|
|
|
95
|
my $addrs = __PACKAGE__->find($email); |
42
|
|
|
|
|
|
|
|
43
|
49
|
100
|
|
|
|
77
|
return undef unless $addrs; |
44
|
44
|
50
|
|
|
|
54
|
return undef unless scalar @$addrs; |
45
|
44
|
|
|
|
|
95
|
return __PACKAGE__->make($addrs->[0]); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub make { |
49
|
|
|
|
|
|
|
# New constructor of Sisimai::Address |
50
|
|
|
|
|
|
|
# @param [Hash] argvs Email address, name, and other elements |
51
|
|
|
|
|
|
|
# @return [Sisimai::Address] Object or Undef when the email address was |
52
|
|
|
|
|
|
|
# not valid. |
53
|
|
|
|
|
|
|
# @since v4.22.1 |
54
|
5954
|
|
|
5954
|
0
|
13274
|
my $class = shift; |
55
|
5954
|
|
100
|
|
|
11228
|
my $argvs = shift // return undef; |
56
|
5953
|
|
|
|
|
23883
|
my $thing = { |
57
|
|
|
|
|
|
|
'address' => '', # Entire email address |
58
|
|
|
|
|
|
|
'user' => '', # Local part |
59
|
|
|
|
|
|
|
'host' => '', # Domain part |
60
|
|
|
|
|
|
|
'verp' => '', # VERP |
61
|
|
|
|
|
|
|
'alias' => '', # Alias |
62
|
|
|
|
|
|
|
'comment' => '', # Comment |
63
|
|
|
|
|
|
|
'name' => '', # Display name |
64
|
|
|
|
|
|
|
}; |
65
|
|
|
|
|
|
|
|
66
|
5953
|
50
|
|
|
|
11866
|
return undef unless ref $argvs eq 'HASH'; |
67
|
5953
|
50
|
|
|
|
9549
|
return undef unless exists $argvs->{'address'}; |
68
|
5953
|
100
|
|
|
|
9428
|
return undef unless $argvs->{'address'}; |
69
|
|
|
|
|
|
|
|
70
|
5952
|
|
|
|
|
8200
|
my $heads = ['<']; |
71
|
5952
|
|
|
|
|
10959
|
my $tails = ['>', ',', '.', ';']; |
72
|
|
|
|
|
|
|
|
73
|
5952
|
100
|
100
|
|
|
26680
|
if( $argvs->{'address'} =~ /\A([^\s]+)[@]([^@]+)\z/ || |
74
|
|
|
|
|
|
|
$argvs->{'address'} =~ /\A(["].+?["])[@]([^@]+)\z/ ) { |
75
|
|
|
|
|
|
|
# Get the local part and the domain part from the email address |
76
|
5938
|
100
|
|
|
|
11161
|
my $lpart = $1; for my $e ( @$heads ) { $lpart =~ s/\A$e//g if substr($lpart, 0, 1) eq $e } |
|
5938
|
|
|
|
|
9344
|
|
|
5938
|
|
|
|
|
12135
|
|
77
|
5938
|
100
|
|
|
|
9454
|
my $dpart = $2; for my $e ( @$tails ) { $dpart =~ s/$e\z//g if substr($dpart, -1, 1) eq $e } |
|
5938
|
|
|
|
|
7609
|
|
|
23752
|
|
|
|
|
31898
|
|
78
|
5938
|
|
100
|
|
|
11502
|
my $email = __PACKAGE__->expand_verp($argvs->{'address'}) || ''; |
79
|
5938
|
|
|
|
|
7447
|
my $alias = 0; |
80
|
|
|
|
|
|
|
|
81
|
5938
|
100
|
|
|
|
8505
|
unless( $email ) { |
82
|
|
|
|
|
|
|
# Is not VERP address, try to expand the address as an alias |
83
|
5937
|
|
100
|
|
|
11117
|
$email = __PACKAGE__->expand_alias($argvs->{'address'}) || ''; |
84
|
5937
|
100
|
|
|
|
10297
|
$alias = 1 if $email; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
5938
|
100
|
|
|
|
8301
|
if( $email =~ /\A.+[@].+?\z/ ) { |
88
|
|
|
|
|
|
|
# The address is a VERP or an alias |
89
|
7
|
100
|
|
|
|
28
|
if( $alias ) { |
90
|
|
|
|
|
|
|
# The address is an alias: neko+nyaan@example.jp |
91
|
6
|
|
|
|
|
14
|
$thing->{'alias'} = $argvs->{'address'}; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
} else { |
94
|
|
|
|
|
|
|
# The address is a VERP: b+neko=example.jp@example.org |
95
|
1
|
|
|
|
|
3
|
$thing->{'verp'} = $argvs->{'address'}; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
} |
98
|
5938
|
|
|
|
|
8579
|
$thing->{'user'} = $lpart; |
99
|
5938
|
|
|
|
|
7681
|
$thing->{'host'} = $dpart; |
100
|
5938
|
|
|
|
|
12494
|
$thing->{'address'} = $lpart.'@'.$dpart; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
} else { |
103
|
|
|
|
|
|
|
# The argument does not include "@" |
104
|
14
|
50
|
|
|
|
61
|
return undef unless Sisimai::RFC5322->is_mailerdaemon($argvs->{'address'}); |
105
|
14
|
50
|
|
|
|
49
|
return undef if rindex($argvs->{'address'}, ' ') > -1; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# The argument does not include " " |
108
|
14
|
|
|
|
|
30
|
$thing->{'user'} = $argvs->{'address'}; |
109
|
14
|
|
|
|
|
30
|
$thing->{'address'} = $argvs->{'address'}; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
5952
|
|
100
|
|
|
13576
|
$thing->{'name'} = $argvs->{'name'} || ''; |
113
|
5952
|
|
100
|
|
|
13723
|
$thing->{'comment'} = $argvs->{'comment'} || ''; |
114
|
5952
|
|
|
|
|
15088
|
return bless($thing, __PACKAGE__); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub find { |
118
|
|
|
|
|
|
|
# Email address parser with a name and a comment |
119
|
|
|
|
|
|
|
# @param [String] argv1 String including email address |
120
|
|
|
|
|
|
|
# @param [Boolean] addrs 0 = Returns list including all the elements |
121
|
|
|
|
|
|
|
# 1 = Returns list including email addresses only |
122
|
|
|
|
|
|
|
# @return [Array, Undef] Email address list or Undef when there is no |
123
|
|
|
|
|
|
|
# email address in the argument |
124
|
|
|
|
|
|
|
# @since v4.22.0 |
125
|
3913
|
|
|
3913
|
1
|
250577
|
my $class = shift; |
126
|
3913
|
|
100
|
|
|
7277
|
my $argv1 = shift // return undef; |
127
|
3912
|
|
100
|
|
|
9974
|
my $addrs = shift // undef; |
128
|
|
|
|
|
|
|
|
129
|
3912
|
|
|
|
|
4574
|
state $indicators = { |
130
|
|
|
|
|
|
|
'email-address' => (1 << 0), # |
131
|
|
|
|
|
|
|
'quoted-string' => (1 << 1), # "Neko, Nyaan" |
132
|
|
|
|
|
|
|
'comment-block' => (1 << 2), # (neko) |
133
|
|
|
|
|
|
|
}; |
134
|
3912
|
|
|
|
|
4192
|
state $delimiters = { '<' => 1, '>' => 1, '(' => 1, ')' => 1, '"' => 1, ',' => 1 }; |
135
|
3912
|
|
|
|
|
4125
|
state $validemail = qr{(?> |
136
|
|
|
|
|
|
|
(?:([^\s]+|["].+?["])) # local part |
137
|
|
|
|
|
|
|
[@] |
138
|
|
|
|
|
|
|
(?:([^@\s]+|[0-9A-Za-z:\.]+)) # domain part |
139
|
|
|
|
|
|
|
) |
140
|
|
|
|
|
|
|
}x; |
141
|
|
|
|
|
|
|
|
142
|
3912
|
|
|
|
|
10396
|
my $emailtable = { 'address' => '', 'name' => '', 'comment' => '' }; |
143
|
3912
|
|
|
|
|
5803
|
my $addrtables = []; |
144
|
3912
|
|
|
|
|
3876
|
my @readbuffer; |
145
|
3912
|
|
|
|
|
4473
|
my $readcursor = 0; |
146
|
3912
|
|
|
|
|
4618
|
my $v = $emailtable; # temporary buffer |
147
|
3912
|
|
|
|
|
4337
|
my $p = ''; # current position |
148
|
|
|
|
|
|
|
|
149
|
3912
|
50
|
|
|
|
8875
|
$argv1 =~ y/\r//d if index($argv1, "\r") > -1; # Remove CR |
150
|
3912
|
100
|
|
|
|
7337
|
$argv1 =~ y/\n//d if index($argv1, "\n") > -1; # Remove NL |
151
|
|
|
|
|
|
|
|
152
|
3912
|
|
|
|
|
25512
|
for my $e ( split('', $argv1) ) { |
153
|
|
|
|
|
|
|
# Check each characters |
154
|
123054
|
100
|
|
|
|
120785
|
if( $delimiters->{ $e } ) { |
155
|
|
|
|
|
|
|
# The character is a delimiter character |
156
|
6881
|
100
|
|
|
|
9573
|
if( $e eq ',' ) { |
157
|
|
|
|
|
|
|
# Separator of email addresses or not |
158
|
557
|
100
|
66
|
|
|
2009
|
if( index($v->{'address'}, '<') == 0 && |
|
|
|
66
|
|
|
|
|
159
|
|
|
|
|
|
|
rindex($v->{'address'}, '@') > -1 && |
160
|
|
|
|
|
|
|
substr($v->{'address'}, -1, 1) eq '>' ) { |
161
|
|
|
|
|
|
|
# An email address has already been picked |
162
|
2
|
50
|
|
|
|
7
|
if( $readcursor & $indicators->{'comment-block'} ) { |
|
|
50
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# The cursor is in the comment block (Neko, Nyaan) |
164
|
0
|
|
|
|
|
0
|
$v->{'comment'} .= $e; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
} elsif( $readcursor & $indicators->{'quoted-string'} ) { |
167
|
|
|
|
|
|
|
# "Neko, Nyaan" |
168
|
0
|
|
|
|
|
0
|
$v->{'name'} .= $e; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
} else { |
171
|
|
|
|
|
|
|
# The cursor is not in neither the quoted-string nor the comment block |
172
|
2
|
|
|
|
|
3
|
$readcursor = 0; # reset cursor position |
173
|
2
|
|
|
|
|
4
|
push @readbuffer, $v; |
174
|
2
|
|
|
|
|
6
|
$v = { 'address' => '', 'name' => '', 'comment' => '' }; |
175
|
2
|
|
|
|
|
2
|
$p = ''; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} else { |
178
|
|
|
|
|
|
|
# "Neko, Nyaan" OR <"neko,nyaan"@example.org> |
179
|
555
|
100
|
|
|
|
983
|
$p ? ($v->{ $p } .= $e) : ($v->{'name'} .= $e); |
180
|
|
|
|
|
|
|
} |
181
|
557
|
|
|
|
|
761
|
next; |
182
|
|
|
|
|
|
|
} # End of if(',') |
183
|
|
|
|
|
|
|
|
184
|
6324
|
100
|
|
|
|
9005
|
if( $e eq '<' ) { |
185
|
|
|
|
|
|
|
# <: The beginning of an email address or not |
186
|
2255
|
50
|
|
|
|
4378
|
if( $v->{'address'} ) { |
187
|
0
|
0
|
|
|
|
0
|
$p ? ($v->{ $p } .= $e) : ($v->{'name'} .= $e); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
} else { |
190
|
|
|
|
|
|
|
# |
191
|
2255
|
|
|
|
|
3952
|
$readcursor |= $indicators->{'email-address'}; |
192
|
2255
|
|
|
|
|
3918
|
$v->{'address'} .= $e; |
193
|
2255
|
|
|
|
|
3461
|
$p = 'address'; |
194
|
|
|
|
|
|
|
} |
195
|
2255
|
|
|
|
|
2678
|
next; |
196
|
|
|
|
|
|
|
} # End of if('<') |
197
|
|
|
|
|
|
|
|
198
|
4069
|
100
|
|
|
|
7327
|
if( $e eq '>' ) { |
199
|
|
|
|
|
|
|
# >: The end of an email address or not |
200
|
2259
|
100
|
|
|
|
5214
|
if( $readcursor & $indicators->{'email-address'} ) { |
201
|
|
|
|
|
|
|
# |
202
|
2255
|
|
|
|
|
4193
|
$readcursor &= ~$indicators->{'email-address'}; |
203
|
2255
|
|
|
|
|
3081
|
$v->{'address'} .= $e; |
204
|
2255
|
|
|
|
|
2848
|
$p = ''; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
} else { |
207
|
|
|
|
|
|
|
# a comment block or a display name |
208
|
4
|
50
|
|
|
|
10
|
$p ? ($v->{'comment'} .= $e) : ($v->{'name'} .= $e); |
209
|
|
|
|
|
|
|
} |
210
|
2259
|
|
|
|
|
2990
|
next; |
211
|
|
|
|
|
|
|
} # End of if('>') |
212
|
|
|
|
|
|
|
|
213
|
1810
|
100
|
|
|
|
2826
|
if( $e eq '(' ) { |
214
|
|
|
|
|
|
|
# The beginning of a comment block or not |
215
|
82
|
100
|
|
|
|
313
|
if( $readcursor & $indicators->{'email-address'} ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# <"neko(nyaan)"@example.org> or |
217
|
2
|
50
|
|
|
|
7
|
if( rindex($v->{'address'}, '"') > -1 ) { |
218
|
|
|
|
|
|
|
# Quoted local part: <"neko(nyaan)"@example.org> |
219
|
0
|
|
|
|
|
0
|
$v->{'address'} .= $e; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
} else { |
222
|
|
|
|
|
|
|
# Comment: |
223
|
2
|
|
|
|
|
3
|
$readcursor |= $indicators->{'comment-block'}; |
224
|
2
|
50
|
|
|
|
7
|
$v->{'comment'} .= ' ' if substr($v->{'comment'}, -1, 1) eq ')'; |
225
|
2
|
|
|
|
|
2
|
$v->{'comment'} .= $e; |
226
|
2
|
|
|
|
|
3
|
$p = 'comment'; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} elsif( $readcursor & $indicators->{'comment-block'} ) { |
229
|
|
|
|
|
|
|
# Comment at the outside of an email address (...(...) |
230
|
0
|
0
|
|
|
|
0
|
$v->{'comment'} .= ' ' if substr($v->{'comment'}, -1, 1) eq ')'; |
231
|
0
|
|
|
|
|
0
|
$v->{'comment'} .= $e; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
} elsif( $readcursor & $indicators->{'quoted-string'} ) { |
234
|
|
|
|
|
|
|
# "Neko, Nyaan(cat)", Deal as a display name |
235
|
0
|
|
|
|
|
0
|
$v->{'name'} .= $e; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
} else { |
238
|
|
|
|
|
|
|
# The beginning of a comment block |
239
|
80
|
|
|
|
|
100
|
$readcursor |= $indicators->{'comment-block'}; |
240
|
80
|
100
|
|
|
|
192
|
$v->{'comment'} .= ' ' if substr($v->{'comment'}, -1, 1) eq ')'; |
241
|
80
|
|
|
|
|
108
|
$v->{'comment'} .= $e; |
242
|
80
|
|
|
|
|
118
|
$p = 'comment'; |
243
|
|
|
|
|
|
|
} |
244
|
82
|
|
|
|
|
85
|
next; |
245
|
|
|
|
|
|
|
} # End of if('(') |
246
|
|
|
|
|
|
|
|
247
|
1728
|
100
|
|
|
|
2417
|
if( $e eq ')' ) { |
248
|
|
|
|
|
|
|
# The end of a comment block or not |
249
|
82
|
100
|
|
|
|
210
|
if( $readcursor & $indicators->{'email-address'} ) { |
|
|
50
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# <"neko(nyaan)"@example.org> OR |
251
|
2
|
50
|
|
|
|
6
|
if( rindex($v->{'address'}, '"') > -1 ) { |
252
|
|
|
|
|
|
|
# Quoted string in the local part: <"neko(nyaan)"@example.org> |
253
|
0
|
|
|
|
|
0
|
$v->{'address'} .= $e; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
} else { |
256
|
|
|
|
|
|
|
# Comment: |
257
|
2
|
|
|
|
|
4
|
$readcursor &= ~$indicators->{'comment-block'}; |
258
|
2
|
|
|
|
|
2
|
$v->{'comment'} .= $e; |
259
|
2
|
|
|
|
|
2
|
$p = 'address'; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
} elsif( $readcursor & $indicators->{'comment-block'} ) { |
262
|
|
|
|
|
|
|
# Comment at the outside of an email address (...(...) |
263
|
80
|
|
|
|
|
135
|
$readcursor &= ~$indicators->{'comment-block'}; |
264
|
80
|
|
|
|
|
94
|
$v->{'comment'} .= $e; |
265
|
80
|
|
|
|
|
84
|
$p = ''; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
} else { |
268
|
|
|
|
|
|
|
# Deal as a display name |
269
|
0
|
|
|
|
|
0
|
$readcursor &= ~$indicators->{'comment-block'}; |
270
|
0
|
|
|
|
|
0
|
$v->{'name'} .= $e; |
271
|
0
|
|
|
|
|
0
|
$p = ''; |
272
|
|
|
|
|
|
|
} |
273
|
82
|
|
|
|
|
95
|
next; |
274
|
|
|
|
|
|
|
} # End of if(')') |
275
|
|
|
|
|
|
|
|
276
|
1646
|
50
|
|
|
|
2385
|
if( $e eq '"' ) { |
277
|
|
|
|
|
|
|
# The beginning or the end of a quoted-string |
278
|
1646
|
50
|
|
|
|
2330
|
if( $p ) { |
279
|
|
|
|
|
|
|
# email-address or comment-block |
280
|
0
|
|
|
|
|
0
|
$v->{ $p } .= $e; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
} else { |
283
|
|
|
|
|
|
|
# Display name like "Neko, Nyaan" |
284
|
1646
|
|
|
|
|
2436
|
$v->{'name'} .= $e; |
285
|
1646
|
50
|
|
|
|
3607
|
next unless $readcursor & $indicators->{'quoted-string'}; |
286
|
0
|
0
|
|
|
|
0
|
next if $v->{'name'} =~ /\x5c["]\z/; # "Neko, Nyaan \"... |
287
|
0
|
|
|
|
|
0
|
$readcursor &= ~$indicators->{'quoted-string'}; |
288
|
0
|
|
|
|
|
0
|
$p = ''; |
289
|
|
|
|
|
|
|
} |
290
|
0
|
|
|
|
|
0
|
next; |
291
|
|
|
|
|
|
|
} # End of if('"') |
292
|
|
|
|
|
|
|
} else { |
293
|
|
|
|
|
|
|
# The character is not a delimiter |
294
|
116173
|
100
|
|
|
|
119009
|
$p ? ($v->{ $p } .= $e) : ($v->{'name'} .= $e); |
295
|
116173
|
|
|
|
|
96501
|
next; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
3912
|
100
|
|
|
|
11780
|
if( $v->{'address'} ) { |
300
|
|
|
|
|
|
|
# Push the latest values |
301
|
2253
|
|
|
|
|
3689
|
push @readbuffer, $v; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
} else { |
304
|
|
|
|
|
|
|
# No email address like in the argument |
305
|
1659
|
100
|
|
|
|
12919
|
if( $v->{'name'} =~ $validemail ) { |
|
|
100
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# String like an email address will be set to the value of "address" |
307
|
1633
|
|
|
|
|
6334
|
$v->{'address'} = $1.'@'.$2; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
} elsif( Sisimai::RFC5322->is_mailerdaemon($v->{'name'}) ) { |
310
|
|
|
|
|
|
|
# Allow if the argument is MAILER-DAEMON |
311
|
5
|
|
|
|
|
10
|
$v->{'address'} = $v->{'name'}; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
1659
|
100
|
|
|
|
3763
|
if( $v->{'address'} ) { |
315
|
|
|
|
|
|
|
# Remove the comment from the address |
316
|
1638
|
50
|
|
|
|
3916
|
if( $v->{'address'} =~ /(.*)([(].+[)])(.*)/ ) { |
317
|
|
|
|
|
|
|
# (nyaan)nekochan@example.org, nekochan(nyaan)cat@example.org or |
318
|
|
|
|
|
|
|
# nekochan(nyaan)@example.org |
319
|
0
|
|
|
|
|
0
|
$v->{'address'} = $1.$3; |
320
|
0
|
|
|
|
|
0
|
$v->{'comment'} = $2; |
321
|
|
|
|
|
|
|
} |
322
|
1638
|
|
|
|
|
2611
|
push @readbuffer, $v; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
3912
|
|
|
|
|
6387
|
for my $e ( @readbuffer ) { |
327
|
|
|
|
|
|
|
# The element must not include any character except from 0x20 to 0x7e. |
328
|
3893
|
50
|
|
|
|
11358
|
next if $e->{'address'} =~ /[^\x20-\x7e]/; |
329
|
3893
|
100
|
|
|
|
14853
|
unless( $e->{'address'} =~ /\A.+[@].+\z/ ) { |
330
|
|
|
|
|
|
|
# Allow if the argument is MAILER-DAEMON |
331
|
20
|
50
|
|
|
|
67
|
next unless Sisimai::RFC5322->is_mailerdaemon($e->{'address'}); |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# Remove angle brackets, other brackets, and quotations: []<>{}'` |
335
|
|
|
|
|
|
|
# except a domain part is an IP address like neko@[192.0.2.222] |
336
|
3893
|
|
|
|
|
9580
|
$e->{'address'} =~ s/\A[\[<{('`]//; |
337
|
3893
|
|
|
|
|
9914
|
$e->{'address'} =~ s/[.'`>});]\z//; |
338
|
3893
|
100
|
|
|
|
10803
|
$e->{'address'} =~ s/\]\z// unless $e->{'address'} =~ /[@]\[[0-9A-Za-z:\.]+\]\z/; |
339
|
|
|
|
|
|
|
|
340
|
3893
|
100
|
|
|
|
8832
|
unless( $e->{'address'} =~ /\A["].+["][@]/ ) { |
341
|
|
|
|
|
|
|
# Remove double-quotations |
342
|
3873
|
100
|
|
|
|
8613
|
substr($e->{'address'}, 0, 1, '') if substr($e->{'address'}, 0, 1) eq '"'; |
343
|
3873
|
100
|
|
|
|
7149
|
substr($e->{'address'}, -1, 1, '') if substr($e->{'address'}, -1, 1) eq '"'; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
3893
|
100
|
|
|
|
6486
|
if( $addrs ) { |
347
|
|
|
|
|
|
|
# Almost compatible with parse() method, returns email address only |
348
|
833
|
|
|
|
|
1441
|
delete $e->{'name'}; |
349
|
833
|
|
|
|
|
919
|
delete $e->{'comment'}; |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
} else { |
352
|
|
|
|
|
|
|
# Remove double-quotations, trailing spaces. |
353
|
3060
|
|
|
|
|
5054
|
for my $f ('name', 'comment') { |
354
|
|
|
|
|
|
|
# Remove traliing spaces |
355
|
6120
|
100
|
|
|
|
11582
|
$e->{ $f } =~ s/\A[ ]//g if index($e->{ $f }, ' ') == 0; |
356
|
6120
|
100
|
|
|
|
15194
|
$e->{ $f } =~ s/[ ]\z//g if substr($e->{ $f }, -1, 1) eq ' '; |
357
|
|
|
|
|
|
|
} |
358
|
3060
|
100
|
|
|
|
6847
|
$e->{'comment'} = '' unless $e->{'comment'} =~ /\A[(].+[)]\z/; |
359
|
3060
|
100
|
|
|
|
9238
|
$e->{'name'} =~ y/ //s unless $e->{'name'} =~ /\A["].+["]\z/; |
360
|
3060
|
100
|
|
|
|
8812
|
$e->{'name'} =~ s/\A["]// unless $e->{'name'} =~ /\A["].+["][@]/; |
361
|
3060
|
100
|
|
|
|
7394
|
substr($e->{'name'}, -1, 1, '') if substr($e->{'name'}, -1, 1) eq '"'; |
362
|
|
|
|
|
|
|
} |
363
|
3893
|
|
|
|
|
8409
|
push @$addrtables, $e; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
3912
|
100
|
|
|
|
6153
|
return undef unless scalar @$addrtables; |
367
|
3891
|
|
|
|
|
12221
|
return $addrtables; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub s3s4 { |
371
|
|
|
|
|
|
|
# Runs like ruleset 3,4 of sendmail.cf |
372
|
|
|
|
|
|
|
# @param [String] input Text including an email address |
373
|
|
|
|
|
|
|
# @return [String] Email address without comment, brackets |
374
|
805
|
|
|
805
|
1
|
172470
|
my $class = shift; |
375
|
805
|
|
100
|
|
|
2244
|
my $input = shift // return undef; |
376
|
804
|
|
100
|
|
|
1820
|
my $addrs = __PACKAGE__->find($input, 1) || []; |
377
|
804
|
100
|
|
|
|
1517
|
return $input unless scalar @$addrs; |
378
|
793
|
|
|
|
|
2845
|
return $addrs->[0]->{'address'}; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub expand_verp { |
382
|
|
|
|
|
|
|
# Expand VERP: Get the original recipient address from VERP |
383
|
|
|
|
|
|
|
# @param [String] email VERP Address |
384
|
|
|
|
|
|
|
# @return [String] Email address |
385
|
5939
|
|
|
5939
|
1
|
6963
|
my $class = shift; |
386
|
5939
|
|
50
|
|
|
9246
|
my $email = shift // return undef; |
387
|
5939
|
|
|
|
|
13762
|
my $local = (split('@', $email, 2))[0]; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
# bounce+neko=example.org@example.org => neko@example.org |
390
|
5939
|
100
|
|
|
|
22310
|
return undef unless $local =~ /\A[-_\w]+?[+](\w[-._\w]+\w)[=](\w[-.\w]+\w)\z/; |
391
|
2
|
|
|
|
|
6
|
my $verp0 = $1.'@'.$2; |
392
|
2
|
50
|
|
|
|
5
|
return $verp0 if Sisimai::RFC5322->is_emailaddress($verp0); |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
sub expand_alias { |
396
|
|
|
|
|
|
|
# Expand alias: remove from '+' to '@' |
397
|
|
|
|
|
|
|
# @param [String] email Email alias string |
398
|
|
|
|
|
|
|
# @return [String] Expanded email address |
399
|
5938
|
|
|
5938
|
1
|
7851
|
my $class = shift; |
400
|
5938
|
|
50
|
|
|
9032
|
my $email = shift // return undef; |
401
|
5938
|
100
|
|
|
|
14242
|
return undef unless Sisimai::RFC5322->is_emailaddress($email); |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
# neko+straycat@example.org => neko@example.org |
404
|
5907
|
|
|
|
|
14270
|
my @local = split('@', $email); |
405
|
5907
|
100
|
|
|
|
21690
|
return undef unless $local[0] =~ /\A([-_\w]+?)[+].+\z/; |
406
|
7
|
|
|
|
|
41
|
return $1.'@'.$local[1]; |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub TO_JSON { |
410
|
|
|
|
|
|
|
# Instance method for JSON::encode() |
411
|
|
|
|
|
|
|
# @return [String] The value of "address" accessor |
412
|
1149
|
|
|
1149
|
0
|
27027
|
my $self = shift; |
413
|
1149
|
|
|
|
|
1604
|
return $self->address; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
1; |
417
|
|
|
|
|
|
|
__END__ |