* [PATCH 2/2] address: use Email::Address::XS if available
2019-12-14 1:02 7% [PATCH 0/2] use Email::Address::XS if available Eric Wong
@ 2019-12-14 1:02 5% ` Eric Wong
0 siblings, 0 replies; 2+ results
From: Eric Wong @ 2019-12-14 1:02 UTC (permalink / raw)
To: meta
Email::Address::XS is a dependency of modern versions of Email::MIME,
so it's likely loaded and installed on newer systems, already;
and capable of handling more corner-cases than our pure-Perl
fallback.
We still fallback to the imperfect-but-good-enough-in-practice
pure-Perl code while avoiding the non-XS Email::Address (which
was susceptible to DoS attacks (CVE-2015-7686)). We just need
to keep "git fast-import" happy.
---
MANIFEST | 1 +
lib/PublicInbox/Address.pm | 44 ++++++++++-------------
lib/PublicInbox/AddressPP.pm | 38 ++++++++++++++++++++
t/address.t | 67 ++++++++++++++++++++++--------------
4 files changed, 98 insertions(+), 52 deletions(-)
create mode 100644 lib/PublicInbox/AddressPP.pm
diff --git a/MANIFEST b/MANIFEST
index 044bbfef..3e760f89 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -81,6 +81,7 @@ examples/unsubscribe.milter
examples/unsubscribe.psgi
examples/varnish-4.vcl
lib/PublicInbox/Address.pm
+lib/PublicInbox/AddressPP.pm
lib/PublicInbox/Admin.pm
lib/PublicInbox/AdminEdit.pm
lib/PublicInbox/AltId.pm
diff --git a/lib/PublicInbox/Address.pm b/lib/PublicInbox/Address.pm
index a58d1eff..433b36eb 100644
--- a/lib/PublicInbox/Address.pm
+++ b/lib/PublicInbox/Address.pm
@@ -4,35 +4,27 @@ package PublicInbox::Address;
use strict;
use warnings;
-# very loose regexes, here. We don't need RFC-compliance,
-# just enough to make thing sanely displayable and pass to git
+sub xs_emails { map { $_->address() } parse_email_addresses($_[0]) }
-sub emails {
- ($_[0] =~ /([\w\.\+=\?"\(\)\-!#\$%&'\*\/\^\`\|\{\}~]+\@[\w\.\-\(\)]+)
- (?:\s[^>]*)?>?\s*(?:\(.*?\))?(?:,\s*|\z)/gx)
+sub xs_names {
+ map {
+ my $n = $_->name;
+ $n = $_->user if $n eq $_->address;
+ $n;
+ } parse_email_addresses($_[0]);
}
-sub names {
- my @p = split(/<?([^@<>]+)\@[\w\.\-]+>?\s*(\(.*?\))?(?:,\s*|\z)/,
- $_[0]);
- my @ret;
- for (my $i = 0; $i <= $#p;) {
- my $phrase = $p[$i++];
- $phrase =~ tr/\r\n\t / /s;
- $phrase =~ s/\A['"\s]*//;
- $phrase =~ s/['"\s]*\z//;
- my $user = $p[$i++] // '';
- my $comment = $p[$i++] // '';
- if ($phrase =~ /\S/) {
- $phrase =~ s/\@\S+\z//;
- push @ret, $phrase;
- } elsif ($comment =~ /\A\((.*?)\)\z/) {
- push @ret, $1;
- } else {
- push @ret, $user;
- }
- }
- @ret;
+eval {
+ require Email::Address::XS;
+ Email::Address::XS->import(qw(parse_email_addresses));
+ *emails = \&xs_emails;
+ *names = \&xs_names;
+};
+
+if ($@) {
+ require PublicInbox::AddressPP;
+ *emails = \&PublicInbox::AddressPP::emails;
+ *names = \&PublicInbox::AddressPP::names;
}
1;
diff --git a/lib/PublicInbox/AddressPP.pm b/lib/PublicInbox/AddressPP.pm
new file mode 100644
index 00000000..cd7aedb9
--- /dev/null
+++ b/lib/PublicInbox/AddressPP.pm
@@ -0,0 +1,38 @@
+# Copyright (C) 2016-2019 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+package PublicInbox::AddressPP;
+use strict;
+
+# very loose regexes, here. We don't need RFC-compliance,
+# just enough to make thing sanely displayable and pass to git
+# We favor Email::Address::XS for conformance if available
+
+sub emails {
+ ($_[0] =~ /([\w\.\+=\?"\(\)\-!#\$%&'\*\/\^\`\|\{\}~]+\@[\w\.\-\(\)]+)
+ (?:\s[^>]*)?>?\s*(?:\(.*?\))?(?:,\s*|\z)/gx)
+}
+
+sub names {
+ my @p = split(/<?([^@<>]+)\@[\w\.\-]+>?\s*(\(.*?\))?(?:,\s*|\z)/,
+ $_[0]);
+ my @ret;
+ for (my $i = 0; $i <= $#p;) {
+ my $phrase = $p[$i++];
+ $phrase =~ tr/\r\n\t / /s;
+ $phrase =~ s/\A['"\s]*//;
+ $phrase =~ s/['"\s]*\z//;
+ my $user = $p[$i++] // '';
+ my $comment = $p[$i++] // '';
+ if ($phrase =~ /\S/) {
+ $phrase =~ s/\@\S+\z//;
+ push @ret, $phrase;
+ } elsif ($comment =~ /\A\((.*?)\)\z/) {
+ push @ret, $1;
+ } else {
+ push @ret, $user;
+ }
+ }
+ @ret;
+}
+
+1;
diff --git a/t/address.t b/t/address.t
index 2a287102..e7c0d6a8 100644
--- a/t/address.t
+++ b/t/address.t
@@ -5,34 +5,49 @@ use warnings;
use Test::More;
use_ok 'PublicInbox::Address';
-is_deeply([qw(e@example.com e@example.org)],
- [PublicInbox::Address::emails('User <e@example.com>, e@example.org')],
- 'address extraction works as expected');
-
-is_deeply(['user@example.com'],
- [PublicInbox::Address::emails('<user@example.com (Comment)>')],
- 'comment after domain accepted before >');
-
-my @names = PublicInbox::Address::names(
- 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>, <y@x> (xyz), '.
- 'U Ser <u@x> (do not use)');
-is_deeply(\@names, ['User', 'e', 'John A. Doe', 'x', 'xyz', 'U Ser'],
- 'name extraction works as expected');
-
-@names = PublicInbox::Address::names('"user@example.com" <user@example.com>');
-is_deeply(['user'], \@names, 'address-as-name extraction works as expected');
-
-
-{
- my $backwards = 'u@example.com (John Q. Public)';
- @names = PublicInbox::Address::names($backwards);
- is_deeply(\@names, ['John Q. Public'], 'backwards name OK');
- my @emails = PublicInbox::Address::emails($backwards);
- is_deeply(\@emails, ['u@example.com'], 'backwards emails OK');
+sub test_pkg {
+ my ($pkg) = @_;
+ my $emails = \&{"${pkg}::emails"};
+ my $names = \&{"${pkg}::names"};
+
+ is_deeply([qw(e@example.com e@example.org)],
+ [$emails->('User <e@example.com>, e@example.org')],
+ 'address extraction works as expected');
+
+ is_deeply(['user@example.com'],
+ [$emails->('<user@example.com (Comment)>')],
+ 'comment after domain accepted before >');
+
+ my @names = $names->(
+ 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>, <y@x> (xyz), '.
+ 'U Ser <u@x> (do not use)');
+ is_deeply(\@names, ['User', 'e', 'John A. Doe', 'x', 'xyz', 'U Ser'],
+ 'name extraction works as expected');
+
+ @names = $names->('"user@example.com" <user@example.com>');
+ is_deeply(['user'], \@names,
+ 'address-as-name extraction works as expected');
+
+ {
+ my $backwards = 'u@example.com (John Q. Public)';
+ @names = $names->($backwards);
+ is_deeply(\@names, ['John Q. Public'], 'backwards name OK');
+ my @emails = $emails->($backwards);
+ is_deeply(\@emails, ['u@example.com'], 'backwards emails OK');
+ }
+
+ @names = $names->('"Quote Unneeded" <user@example.com>');
+ is_deeply(['Quote Unneeded'], \@names, 'extra quotes dropped');
}
+test_pkg('PublicInbox::Address');
-@names = PublicInbox::Address::names('"Quote Unneeded" <user@example.com>');
-is_deeply(['Quote Unneeded'], \@names, 'extra quotes dropped');
+SKIP: {
+ if ($INC{'PublicInbox/AddressPP.pm'}) {
+ skip 'Email::Address::XS missing', 8;
+ }
+ use_ok 'PublicInbox::AddressPP';
+ test_pkg('PublicInbox::AddressPP');
+}
done_testing;
^ permalink raw reply related [relevance 5%]
* [PATCH 0/2] use Email::Address::XS if available
@ 2019-12-14 1:02 7% Eric Wong
2019-12-14 1:02 5% ` [PATCH 2/2] address: " Eric Wong
0 siblings, 1 reply; 2+ results
From: Eric Wong @ 2019-12-14 1:02 UTC (permalink / raw)
To: meta
Email::Address::XS is loaded by default on modern Email::MIME
(which we depend on), so we might as well use it. 1/2 also
improves the pure-Perl fallback to match optimal ::XS behavior.
Eric Wong (2):
address: use comment as name if no phrase available
address: use Email::Address::XS if available
MANIFEST | 1 +
lib/PublicInbox/Address.pm | 34 ++++++++++---------
lib/PublicInbox/AddressPP.pm | 38 +++++++++++++++++++++
t/address.t | 66 ++++++++++++++++++++++--------------
4 files changed, 98 insertions(+), 41 deletions(-)
create mode 100644 lib/PublicInbox/AddressPP.pm
^ permalink raw reply [relevance 7%]
Results 1-2 of 2 | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2019-12-14 1:02 7% [PATCH 0/2] use Email::Address::XS if available Eric Wong
2019-12-14 1:02 5% ` [PATCH 2/2] address: " Eric Wong
Code repositories for project(s) associated with this public inbox
https://80x24.org/public-inbox.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).