line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sisimai::Address; |
2
|
83
|
|
|
83
|
|
74357
|
use feature ':5.10'; |
|
83
|
|
|
|
|
188
|
|
|
83
|
|
|
|
|
6268
|
|
3
|
83
|
|
|
83
|
|
485
|
use strict; |
|
83
|
|
|
|
|
126
|
|
|
83
|
|
|
|
|
1575
|
|
4
|
83
|
|
|
83
|
|
359
|
use warnings; |
|
83
|
|
|
|
|
153
|
|
|
83
|
|
|
|
|
2077
|
|
5
|
83
|
|
|
83
|
|
7987
|
use Sisimai::RFC5322; |
|
83
|
|
|
|
|
147
|
|
|
83
|
|
|
|
|
3594
|
|
6
|
|
|
|
|
|
|
use Class::Accessor::Lite ( |
7
|
83
|
|
|
|
|
703
|
'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
|
83
|
|
|
83
|
|
6067
|
); |
|
83
|
|
|
|
|
14293
|
|
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
|
421
|
my $class = shift; |
27
|
18
|
|
100
|
|
|
80
|
my $atype = shift || return undef; |
28
|
|
|
|
|
|
|
|
29
|
17
|
50
|
|
|
|
97
|
return undef unless $atype =~ /\A(?:r|s)\z/; |
30
|
17
|
100
|
|
|
|
66
|
my $local = $atype eq 'r' ? 'recipient' : 'sender'; |
31
|
17
|
|
|
|
|
120
|
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
|
40684
|
my $class = shift; |
40
|
50
|
|
100
|
|
|
117
|
my $email = shift // return undef; |
41
|
49
|
|
|
|
|
97
|
my $addrs = __PACKAGE__->find($email); |
42
|
|
|
|
|
|
|
|
43
|
49
|
100
|
|
|
|
95
|
return undef unless $addrs; |
44
|
44
|
50
|
|
|
|
73
|
return undef unless scalar @$addrs; |
45
|
44
|
|
|
|
|
115
|
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
|
6014
|
|
|
6014
|
0
|
16445
|
my $class = shift; |
55
|
6014
|
|
100
|
|
|
10648
|
my $argvs = shift // return undef; |
56
|
6013
|
|
|
|
|
27717
|
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
|
6013
|
50
|
|
|
|
14367
|
return undef unless ref $argvs eq 'HASH'; |
67
|
6013
|
50
|
|
|
|
10757
|
return undef unless exists $argvs->{'address'}; |
68
|
6013
|
100
|
|
|
|
10041
|
return undef unless $argvs->{'address'}; |
69
|
|
|
|
|
|
|
|
70
|
6012
|
|
|
|
|
9701
|
my $heads = ['<']; |
71
|
6012
|
|
|
|
|
12133
|
my $tails = ['>', ',', '.', ';']; |
72
|
|
|
|
|
|
|
|
73
|
6012
|
100
|
100
|
|
|
29606
|
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
|
5998
|
100
|
|
|
|
12791
|
my $lpart = $1; for my $e ( @$heads ) { $lpart =~ s/\A$e//g if substr($lpart, 0, 1) eq $e } |
|
5998
|
|
|
|
|
9847
|
|
|
5998
|
|
|
|
|
13748
|
|
77
|
5998
|
100
|
|
|
|
11084
|
my $dpart = $2; for my $e ( @$tails ) { $dpart =~ s/$e\z//g if substr($dpart, -1, 1) eq $e } |
|
5998
|
|
|
|
|
7601
|
|
|
23992
|
|
|
|
|
36644
|
|
78
|
5998
|
|
100
|
|
|
13489
|
my $email = __PACKAGE__->expand_verp($argvs->{'address'}) || ''; |
79
|
5998
|
|
|
|
|
7544
|
my $alias = 0; |
80
|
|
|
|
|
|
|
|
81
|
5998
|
100
|
|
|
|
9420
|
unless( $email ) { |
82
|
|
|
|
|
|
|
# Is not VERP address, try to expand the address as an alias |
83
|
5997
|
|
100
|
|
|
11320
|
$email = __PACKAGE__->expand_alias($argvs->{'address'}) || ''; |
84
|
5997
|
100
|
|
|
|
11194
|
$alias = 1 if $email; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
5998
|
100
|
|
|
|
9835
|
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
|
|
|
|
|
17
|
$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
|
5998
|
|
|
|
|
9349
|
$thing->{'user'} = $lpart; |
99
|
5998
|
|
|
|
|
8411
|
$thing->{'host'} = $dpart; |
100
|
5998
|
|
|
|
|
15614
|
$thing->{'address'} = $lpart.'@'.$dpart; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
} else { |
103
|
|
|
|
|
|
|
# The argument does not include "@" |
104
|
14
|
50
|
|
|
|
59
|
return undef unless Sisimai::RFC5322->is_mailerdaemon($argvs->{'address'}); |
105
|
14
|
50
|
|
|
|
62
|
return undef if rindex($argvs->{'address'}, ' ') > -1; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# The argument does not include " " |
108
|
14
|
|
|
|
|
48
|
$thing->{'user'} = $argvs->{'address'}; |
109
|
14
|
|
|
|
|
32
|
$thing->{'address'} = $argvs->{'address'}; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
6012
|
|
100
|
|
|
16920
|
$thing->{'name'} = $argvs->{'name'} || ''; |
113
|
6012
|
|
100
|
|
|
16416
|
$thing->{'comment'} = $argvs->{'comment'} || ''; |
114
|
6012
|
|
|
|
|
18186
|
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
|
3943
|
|
|
3943
|
1
|
324258
|
my $class = shift; |
126
|
3943
|
|
100
|
|
|
8031
|
my $argv1 = shift // return undef; |
127
|
3942
|
|
100
|
|
|
9945
|
my $addrs = shift // undef; |
128
|
|
|
|
|
|
|
|
129
|
3942
|
|
|
|
|
6572
|
state $indicators = { |
130
|
|
|
|
|
|
|
'email-address' => (1 << 0), # |
131
|
|
|
|
|
|
|
'quoted-string' => (1 << 1), # "Neko, Nyaan" |
132
|
|
|
|
|
|
|
'comment-block' => (1 << 2), # (neko) |
133
|
|
|
|
|
|
|
}; |
134
|
3942
|
|
|
|
|
5083
|
state $delimiters = { '<' => 1, '>' => 1, '(' => 1, ')' => 1, '"' => 1, ',' => 1 }; |
135
|
3942
|
|
|
|
|
4393
|
state $validemail = qr{(?> |
136
|
|
|
|
|
|
|
(?:([^\s]+|["].+?["])) # local part |
137
|
|
|
|
|
|
|
[@] |
138
|
|
|
|
|
|
|
(?:([^@\s]+|[0-9A-Za-z:\.]+)) # domain part |
139
|
|
|
|
|
|
|
) |
140
|
|
|
|
|
|
|
}x; |
141
|
|
|
|
|
|
|
|
142
|
3942
|
|
|
|
|
10777
|
my $emailtable = { 'address' => '', 'name' => '', 'comment' => '' }; |
143
|
3942
|
|
|
|
|
5385
|
my $addrtables = []; |
144
|
3942
|
|
|
|
|
4806
|
my @readbuffer; |
145
|
3942
|
|
|
|
|
4247
|
my $readcursor = 0; |
146
|
3942
|
|
|
|
|
4592
|
my $v = $emailtable; # temporary buffer |
147
|
3942
|
|
|
|
|
5366
|
my $p = ''; # current position |
148
|
|
|
|
|
|
|
|
149
|
3942
|
50
|
|
|
|
8737
|
$argv1 =~ y/\r//d if index($argv1, "\r") > -1; # Remove CR |
150
|
3942
|
100
|
|
|
|
7087
|
$argv1 =~ y/\n//d if index($argv1, "\n") > -1; # Remove NL |
151
|
|
|
|
|
|
|
|
152
|
3942
|
|
|
|
|
33146
|
for my $e ( split('', $argv1) ) { |
153
|
|
|
|
|
|
|
# Check each characters |
154
|
123906
|
100
|
|
|
|
148499
|
if( $delimiters->{ $e } ) { |
155
|
|
|
|
|
|
|
# The character is a delimiter character |
156
|
6935
|
100
|
|
|
|
11152
|
if( $e eq ',' ) { |
157
|
|
|
|
|
|
|
# Separator of email addresses or not |
158
|
563
|
100
|
66
|
|
|
2670
|
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
|
|
|
|
22
|
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
|
|
|
|
|
8
|
$readcursor = 0; # reset cursor position |
173
|
2
|
|
|
|
|
4
|
push @readbuffer, $v; |
174
|
2
|
|
|
|
|
6
|
$v = { 'address' => '', 'name' => '', 'comment' => '' }; |
175
|
2
|
|
|
|
|
5
|
$p = ''; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} else { |
178
|
|
|
|
|
|
|
# "Neko, Nyaan" OR <"neko,nyaan"@example.org> |
179
|
561
|
100
|
|
|
|
1452
|
$p ? ($v->{ $p } .= $e) : ($v->{'name'} .= $e); |
180
|
|
|
|
|
|
|
} |
181
|
563
|
|
|
|
|
811
|
next; |
182
|
|
|
|
|
|
|
} # End of if(',') |
183
|
|
|
|
|
|
|
|
184
|
6372
|
100
|
|
|
|
10186
|
if( $e eq '<' ) { |
185
|
|
|
|
|
|
|
# <: The beginning of an email address or not |
186
|
2273
|
50
|
|
|
|
3999
|
if( $v->{'address'} ) { |
187
|
0
|
0
|
|
|
|
0
|
$p ? ($v->{ $p } .= $e) : ($v->{'name'} .= $e); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
} else { |
190
|
|
|
|
|
|
|
# |
191
|
2273
|
|
|
|
|
3392
|
$readcursor |= $indicators->{'email-address'}; |
192
|
2273
|
|
|
|
|
3959
|
$v->{'address'} .= $e; |
193
|
2273
|
|
|
|
|
3251
|
$p = 'address'; |
194
|
|
|
|
|
|
|
} |
195
|
2273
|
|
|
|
|
2924
|
next; |
196
|
|
|
|
|
|
|
} # End of if('<') |
197
|
|
|
|
|
|
|
|
198
|
4099
|
100
|
|
|
|
7581
|
if( $e eq '>' ) { |
199
|
|
|
|
|
|
|
# >: The end of an email address or not |
200
|
2277
|
100
|
|
|
|
5047
|
if( $readcursor & $indicators->{'email-address'} ) { |
201
|
|
|
|
|
|
|
# |
202
|
2273
|
|
|
|
|
3936
|
$readcursor &= ~$indicators->{'email-address'}; |
203
|
2273
|
|
|
|
|
3036
|
$v->{'address'} .= $e; |
204
|
2273
|
|
|
|
|
3242
|
$p = ''; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
} else { |
207
|
|
|
|
|
|
|
# a comment block or a display name |
208
|
4
|
50
|
|
|
|
15
|
$p ? ($v->{'comment'} .= $e) : ($v->{'name'} .= $e); |
209
|
|
|
|
|
|
|
} |
210
|
2277
|
|
|
|
|
4216
|
next; |
211
|
|
|
|
|
|
|
} # End of if('>') |
212
|
|
|
|
|
|
|
|
213
|
1822
|
100
|
|
|
|
3071
|
if( $e eq '(' ) { |
214
|
|
|
|
|
|
|
# The beginning of a comment block or not |
215
|
82
|
100
|
|
|
|
456
|
if( $readcursor & $indicators->{'email-address'} ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# <"neko(nyaan)"@example.org> or |
217
|
2
|
50
|
|
|
|
8
|
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
|
|
|
|
|
5
|
$readcursor |= $indicators->{'comment-block'}; |
224
|
2
|
50
|
|
|
|
7
|
$v->{'comment'} .= ' ' if substr($v->{'comment'}, -1, 1) eq ')'; |
225
|
2
|
|
|
|
|
4
|
$v->{'comment'} .= $e; |
226
|
2
|
|
|
|
|
5
|
$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
|
|
|
|
|
131
|
$readcursor |= $indicators->{'comment-block'}; |
240
|
80
|
100
|
|
|
|
210
|
$v->{'comment'} .= ' ' if substr($v->{'comment'}, -1, 1) eq ')'; |
241
|
80
|
|
|
|
|
137
|
$v->{'comment'} .= $e; |
242
|
80
|
|
|
|
|
126
|
$p = 'comment'; |
243
|
|
|
|
|
|
|
} |
244
|
82
|
|
|
|
|
144
|
next; |
245
|
|
|
|
|
|
|
} # End of if('(') |
246
|
|
|
|
|
|
|
|
247
|
1740
|
100
|
|
|
|
2836
|
if( $e eq ')' ) { |
248
|
|
|
|
|
|
|
# The end of a comment block or not |
249
|
82
|
100
|
|
|
|
414
|
if( $readcursor & $indicators->{'email-address'} ) { |
|
|
50
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# <"neko(nyaan)"@example.org> OR |
251
|
2
|
50
|
|
|
|
5
|
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
|
|
|
|
|
5
|
$readcursor &= ~$indicators->{'comment-block'}; |
258
|
2
|
|
|
|
|
3
|
$v->{'comment'} .= $e; |
259
|
2
|
|
|
|
|
3
|
$p = 'address'; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
} elsif( $readcursor & $indicators->{'comment-block'} ) { |
262
|
|
|
|
|
|
|
# Comment at the outside of an email address (...(...) |
263
|
80
|
|
|
|
|
159
|
$readcursor &= ~$indicators->{'comment-block'}; |
264
|
80
|
|
|
|
|
109
|
$v->{'comment'} .= $e; |
265
|
80
|
|
|
|
|
143
|
$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
|
|
|
|
|
123
|
next; |
274
|
|
|
|
|
|
|
} # End of if(')') |
275
|
|
|
|
|
|
|
|
276
|
1658
|
50
|
|
|
|
2699
|
if( $e eq '"' ) { |
277
|
|
|
|
|
|
|
# The beginning or the end of a quoted-string |
278
|
1658
|
50
|
|
|
|
2196
|
if( $p ) { |
279
|
|
|
|
|
|
|
# email-address or comment-block |
280
|
0
|
|
|
|
|
0
|
$v->{ $p } .= $e; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
} else { |
283
|
|
|
|
|
|
|
# Display name like "Neko, Nyaan" |
284
|
1658
|
|
|
|
|
2705
|
$v->{'name'} .= $e; |
285
|
1658
|
50
|
|
|
|
3800
|
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
|
116971
|
100
|
|
|
|
144072
|
$p ? ($v->{ $p } .= $e) : ($v->{'name'} .= $e); |
295
|
116971
|
|
|
|
|
119212
|
next; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
3942
|
100
|
|
|
|
13866
|
if( $v->{'address'} ) { |
300
|
|
|
|
|
|
|
# Push the latest values |
301
|
2271
|
|
|
|
|
3584
|
push @readbuffer, $v; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
} else { |
304
|
|
|
|
|
|
|
# No email address like in the argument |
305
|
1671
|
100
|
|
|
|
15754
|
if( $v->{'name'} =~ $validemail ) { |
|
|
100
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# String like an email address will be set to the value of "address" |
307
|
1645
|
|
|
|
|
6994
|
$v->{'address'} = $1.'@'.$2; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
} elsif( Sisimai::RFC5322->is_mailerdaemon($v->{'name'}) ) { |
310
|
|
|
|
|
|
|
# Allow if the argument is MAILER-DAEMON |
311
|
5
|
|
|
|
|
14
|
$v->{'address'} = $v->{'name'}; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
1671
|
100
|
|
|
|
3649
|
if( $v->{'address'} ) { |
315
|
|
|
|
|
|
|
# Remove the comment from the address |
316
|
1650
|
50
|
|
|
|
4519
|
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
|
1650
|
|
|
|
|
2795
|
push @readbuffer, $v; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
3942
|
|
|
|
|
5521
|
for my $e ( @readbuffer ) { |
327
|
|
|
|
|
|
|
# The element must not include any character except from 0x20 to 0x7e. |
328
|
3923
|
50
|
|
|
|
12939
|
next if $e->{'address'} =~ /[^\x20-\x7e]/; |
329
|
3923
|
100
|
|
|
|
15999
|
unless( $e->{'address'} =~ /\A.+[@].+\z/ ) { |
330
|
|
|
|
|
|
|
# Allow if the argument is MAILER-DAEMON |
331
|
20
|
50
|
|
|
|
140
|
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
|
3923
|
|
|
|
|
10630
|
$e->{'address'} =~ s/\A[\[<{('`]//; |
337
|
3923
|
|
|
|
|
10856
|
$e->{'address'} =~ s/[.'`>});]\z//; |
338
|
3923
|
100
|
|
|
|
11630
|
$e->{'address'} =~ s/\]\z// unless $e->{'address'} =~ /[@]\[[0-9A-Za-z:\.]+\]\z/; |
339
|
|
|
|
|
|
|
|
340
|
3923
|
100
|
|
|
|
8337
|
unless( $e->{'address'} =~ /\A["].+["][@]/ ) { |
341
|
|
|
|
|
|
|
# Remove double-quotations |
342
|
3903
|
100
|
|
|
|
9535
|
substr($e->{'address'}, 0, 1, '') if substr($e->{'address'}, 0, 1) eq '"'; |
343
|
3903
|
100
|
|
|
|
7409
|
substr($e->{'address'}, -1, 1, '') if substr($e->{'address'}, -1, 1) eq '"'; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
3923
|
100
|
|
|
|
6249
|
if( $addrs ) { |
347
|
|
|
|
|
|
|
# Almost compatible with parse() method, returns email address only |
348
|
833
|
|
|
|
|
1618
|
delete $e->{'name'}; |
349
|
833
|
|
|
|
|
1119
|
delete $e->{'comment'}; |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
} else { |
352
|
|
|
|
|
|
|
# Remove double-quotations, trailing spaces. |
353
|
3090
|
|
|
|
|
4645
|
for my $f ('name', 'comment') { |
354
|
|
|
|
|
|
|
# Remove traliing spaces |
355
|
6180
|
100
|
|
|
|
12917
|
$e->{ $f } =~ s/\A[ ]//g if index($e->{ $f }, ' ') == 0; |
356
|
6180
|
100
|
|
|
|
17188
|
$e->{ $f } =~ s/[ ]\z//g if substr($e->{ $f }, -1, 1) eq ' '; |
357
|
|
|
|
|
|
|
} |
358
|
3090
|
100
|
|
|
|
7668
|
$e->{'comment'} = '' unless $e->{'comment'} =~ /\A[(].+[)]\z/; |
359
|
3090
|
100
|
|
|
|
9596
|
$e->{'name'} =~ y/ //s unless $e->{'name'} =~ /\A["].+["]\z/; |
360
|
3090
|
100
|
|
|
|
9165
|
$e->{'name'} =~ s/\A["]// unless $e->{'name'} =~ /\A["].+["][@]/; |
361
|
3090
|
100
|
|
|
|
7265
|
substr($e->{'name'}, -1, 1, '') if substr($e->{'name'}, -1, 1) eq '"'; |
362
|
|
|
|
|
|
|
} |
363
|
3923
|
|
|
|
|
8595
|
push @$addrtables, $e; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
3942
|
100
|
|
|
|
7653
|
return undef unless scalar @$addrtables; |
367
|
3921
|
|
|
|
|
13747
|
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
|
222058
|
my $class = shift; |
375
|
805
|
|
100
|
|
|
2702
|
my $input = shift // return undef; |
376
|
804
|
|
100
|
|
|
2038
|
my $addrs = __PACKAGE__->find($input, 1) || []; |
377
|
804
|
100
|
|
|
|
1754
|
return $input unless scalar @$addrs; |
378
|
793
|
|
|
|
|
3437
|
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
|
5999
|
|
|
5999
|
1
|
8551
|
my $class = shift; |
386
|
5999
|
|
50
|
|
|
11057
|
my $email = shift // return undef; |
387
|
5999
|
|
|
|
|
16991
|
my $local = (split('@', $email, 2))[0]; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
# bounce+neko=example.org@example.org => neko@example.org |
390
|
5999
|
100
|
|
|
|
26219
|
return undef unless $local =~ /\A[-_\w]+?[+](\w[-._\w]+\w)[=](\w[-.\w]+\w)\z/; |
391
|
2
|
|
|
|
|
25
|
my $verp0 = $1.'@'.$2; |
392
|
2
|
50
|
|
|
|
8
|
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
|
5998
|
|
|
5998
|
1
|
7234
|
my $class = shift; |
400
|
5998
|
|
50
|
|
|
9528
|
my $email = shift // return undef; |
401
|
5998
|
100
|
|
|
|
13807
|
return undef unless Sisimai::RFC5322->is_emailaddress($email); |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
# neko+straycat@example.org => neko@example.org |
404
|
5967
|
|
|
|
|
16158
|
my @local = split('@', $email); |
405
|
5967
|
100
|
|
|
|
24976
|
return undef unless $local[0] =~ /\A([-_\w]+?)[+].+\z/; |
406
|
7
|
|
|
|
|
52
|
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
|
1159
|
|
|
1159
|
0
|
39859
|
my $self = shift; |
413
|
1159
|
|
|
|
|
2058
|
return $self->address; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
1; |
417
|
|
|
|
|
|
|
__END__ |