diff --git a/lib/Email/Address.pm b/lib/Email/Address.pm index f642b77..7fe1deb 100644 --- a/lib/Email/Address.pm +++ b/lib/Email/Address.pm @@ -54,7 +54,11 @@ my $cfws = qr/$comment|(?>\s+)/; my $atext = qq/[^$CTL$special\\s]/; my $atom = qr/(?>$cfws*$atext+$cfws*)/; my $dot_atom_text = qr/(?>$atext+(?:\.$atext+)*)/; +my $fqdn_atom_text = qr/(?>$atext+\.$atext+(?:\.$atext+)*)/; # Requires at least one dot +my $localhost_text = qr/localhost/i; my $dot_atom = qr/(?>$cfws*$dot_atom_text$cfws*)/; +my $fqdn_atom = qr/(?>$cfws*$fqdn_atom_text$cfws*)/; +my $localhost_atom = qr/(?>$cfws*$localhost_text$cfws*)/; my $qtext = qr/[^\\"]/; my $qcontent = qr/$qtext|$quoted_pair/; @@ -83,7 +87,7 @@ my $local_part = qr/$dot_atom|$quoted_string/; my $dtext = qr/[^\[\]\\]/; my $dcontent = qr/$dtext|$quoted_pair/; my $domain_literal = qr/(?>$cfws*\[(?:\s*$dcontent)*\s*\]$cfws*)/; -my $domain = qr/$dot_atom|$domain_literal/; +my $domain = qr/$fqdn_atom|$localhost_atom|$domain_literal/; my $display_name = $phrase; diff --git a/t/rfc5322-compliance.t b/t/rfc5322-compliance.t new file mode 100755 index 0000000..4119f16 --- /dev/null +++ b/t/rfc5322-compliance.t @@ -0,0 +1,50 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Email::Address; + +# Regression test for RFC 5322 compliance issue found in Koha +# Email::Address should reject addresses without proper TLD per RFC 5322 + +# Test addresses that should be INVALID (missing TLD) +my @invalid_addresses = ( + 'test@gmail', + 'admin@server', + 'user@domain', +); + +# Test addresses that should be VALID (proper FQDN) +my @valid_addresses = ( + 'test@gmail.com', + 'user@localhost', # localhost is a special case that may be valid + 'admin@server.example.com', +); + +# Test that invalid addresses are rejected +for my $addr (@invalid_addresses) { + my @parsed = Email::Address->parse($addr); + is(scalar(@parsed), 0, "$addr should be rejected (missing TLD)"); +} + +# Test that valid addresses are accepted +for my $addr (@valid_addresses) { + my @parsed = Email::Address->parse($addr); + is(scalar(@parsed), 1, "$addr should be accepted (valid FQDN)"); +} + +done_testing(); + +__END__ + +=head1 NAME + +rfc5322-compliance.t - Regression test for RFC 5322 compliance + +=head1 DESCRIPTION + +This test ensures Email::Address properly rejects email addresses that violate +RFC 5322 by lacking fully qualified domain names (FQDN). + +Currently FAILS because Email::Address incorrectly accepts addresses like +'test@gmail' when they should be rejected per RFC 5322.