From 235b55840c4066029e56ed91d6d3dc46c921a23b Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Sun, 10 Dec 2023 13:42:52 +0000 Subject: imap: replace Mail::Address fallback with AddressPP Our pure-Perl (PublicInbox::AddressPP) fallback is closer to the preferred Email::Address::XS (EAX) behavior than Mail::Address is for ->name support. EAX tends to be overkill with good spam filtering, and using our own fallback means life is easier for users with neither C/XS build tools nor a pre-built EAX package. --- INSTALL | 3 +-- lib/PublicInbox/Address.pm | 9 +++++---- lib/PublicInbox/AddressPP.pm | 12 +++++++++++- lib/PublicInbox/IMAP.pm | 10 ++-------- lib/PublicInbox/TestCommon.pm | 3 +-- t/address.t | 19 ++++++++++++++++--- 6 files changed, 36 insertions(+), 20 deletions(-) diff --git a/INSTALL b/INSTALL index 52bc9447..c5d69d1b 100644 --- a/INSTALL +++ b/INSTALL @@ -83,8 +83,7 @@ Numerous optional modules are likely to be useful as well: - Email::Address::XS deb: libemail-address-xs-perl pkg: p5-Email-Address-XS (correct parsing of tricky email - addresses, phrases and comments, - required for IMAP) + addresses, phrases and comments) - Parse::RecDescent deb: libparse-recdescent-perl pkg: p5-Parse-RecDescent diff --git a/lib/PublicInbox/Address.pm b/lib/PublicInbox/Address.pm index 2c9c4395..a5902cfd 100644 --- a/lib/PublicInbox/Address.pm +++ b/lib/PublicInbox/Address.pm @@ -1,9 +1,8 @@ -# Copyright (C) 2016-2021 all contributors +# Copyright (C) all contributors # License: AGPL-3.0+ package PublicInbox::Address; -use strict; -use v5.10.1; -use parent 'Exporter'; +use v5.12; +use parent qw(Exporter); our @EXPORT_OK = qw(pairs); sub xs_emails { @@ -31,6 +30,7 @@ eval { *emails = \&xs_emails; *names = \&xs_names; *pairs = \&xs_pairs; + *objects = sub { Email::Address::XS->parse(@_) }; }; if ($@) { @@ -38,6 +38,7 @@ if ($@) { *emails = \&PublicInbox::AddressPP::emails; *names = \&PublicInbox::AddressPP::names; *pairs = \&PublicInbox::AddressPP::pairs; + *objects = \&PublicInbox::AddressPP::objects; } 1; diff --git a/lib/PublicInbox/AddressPP.pm b/lib/PublicInbox/AddressPP.pm index 6a3ae4fe..65ba36a9 100644 --- a/lib/PublicInbox/AddressPP.pm +++ b/lib/PublicInbox/AddressPP.pm @@ -1,7 +1,8 @@ -# Copyright (C) 2016-2021 all contributors +# Copyright (C) all contributors # License: AGPL-3.0+ package PublicInbox::AddressPP; use strict; +use v5.10.1; # TODO check regexps for unicode_strings compat # very loose regexes, here. We don't need RFC-compliance, # just enough to make thing sanely displayable and pass to git @@ -56,4 +57,13 @@ sub pairs { # for JMAP, RFC 8621 section 4.1.2.3 } emails($s) ]; } +# Mail::Address->name is inconsistent with Email::Address::XS, so we're +# doing our own thing, here: +sub objects { map { bless $_, __PACKAGE__ } @{pairs($_[0])} } + +# OO API for objects() results +sub user { (split(/@/, $_[0]->[1]))[0] } +sub host { (split(/@/, $_[0]->[1]))[1] } +sub name { $_[0]->[0] // user($_[0]) } + 1; diff --git a/lib/PublicInbox/IMAP.pm b/lib/PublicInbox/IMAP.pm index e4a9e304..b12533cb 100644 --- a/lib/PublicInbox/IMAP.pm +++ b/lib/PublicInbox/IMAP.pm @@ -39,13 +39,7 @@ use PublicInbox::DS qw(now); use PublicInbox::GitAsyncCat; use Text::ParseWords qw(parse_line); use Errno qw(EAGAIN); - -my $Address; -for my $mod (qw(Email::Address::XS Mail::Address)) { - eval "require $mod" or next; - $Address = $mod and last; -} -die "neither Email::Address::XS nor Mail::Address loaded: $@" if !$Address; +use PublicInbox::Address; sub LINE_MAX () { 8000 } # RFC 2683 3.2.1.5 @@ -438,7 +432,7 @@ sub addr_envelope ($$;$) { my $v = $eml->header_raw($x) // ($y ? $eml->header_raw($y) : undef) // return 'NIL'; - my @x = $Address->parse($v) or return 'NIL'; + my @x = PublicInbox::Address::objects($v) or return 'NIL'; '(' . join('', map { '(' . join(' ', _esc($_->name), 'NIL', diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm index f2914d09..5f123eb4 100644 --- a/lib/PublicInbox/TestCommon.pm +++ b/lib/PublicInbox/TestCommon.pm @@ -196,8 +196,7 @@ sub require_mods { push @mods, qw(Plack::Builder Plack::Util); next; } elsif ($mod eq '-imapd') { - push @mods, qw(Parse::RecDescent DBD::SQLite - Email::Address::XS||Mail::Address); + push @mods, qw(Parse::RecDescent DBD::SQLite); next; } elsif ($mod eq '-nntpd' || $mod eq 'v2') { push @mods, qw(DBD::SQLite); diff --git a/t/address.t b/t/address.t index 6aa94628..16000d2d 100644 --- a/t/address.t +++ b/t/address.t @@ -1,7 +1,7 @@ -# Copyright (C) 2016-2021 all contributors +#!perl -w +# Copyright (C) all contributors # License: AGPL-3.0+ -use strict; -use warnings; +use v5.12; use Test::More; use_ok 'PublicInbox::Address'; @@ -10,6 +10,7 @@ sub test_pkg { my $emails = $pkg->can('emails'); my $names = $pkg->can('names'); my $pairs = $pkg->can('pairs'); + my $objects = $pkg->can('objects'); is_deeply([qw(e@example.com e@example.org)], [$emails->('User , e@example.org')], @@ -35,6 +36,18 @@ sub test_pkg { [ 'xyz', 'y@x' ], [ 'U Ser', 'u@x' ] ], "pairs extraction works for $pkg"); + # only what's used by PublicInbox::IMAP: + my @objs = $objects->($s); + my @exp = (qw(User e e), qw(e e e), ('John A. Doe', qw(j d)), + qw(x x x), qw(xyz y x), ('U Ser', qw(u x))); + for (my $i = 0; $i <= $#objs; $i++) { + my $exp_name = shift @exp; + my $name = $objs[$i]->name; + is $name, $exp_name, "->name #$i matches"; + is $objs[$i]->user, shift @exp, "->user #$i matches"; + is $objs[$i]->host , shift @exp, "->host #$i matches"; + } + @names = $names->('"user@example.com" '); is_deeply(['user'], \@names, 'address-as-name extraction works as expected'); -- cgit v1.2.3-24-ge0c7