cvs commit: qpsmtpd/lib/Qpsmtpd SMTP.pm
[email protected] (Ask "Bj?rn" Hansen)
| Newsgroups | perl.cvs.qpsmtpd |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/07/15 19:22:11
Modified: lib/Qpsmtpd SMTP.pm
Log:
take out spurious warning
improve address parsing a bit to make it easier to add parsing of MAIL
FROM extensions
Revision Changes Path
1.31 +7 -2 qpsmtpd/lib/Qpsmtpd/SMTP.pm
Index: SMTP.pm
===================================================================
RCS file: /cvs/public/qpsmtpd/lib/Qpsmtpd/SMTP.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- SMTP.pm 14 Jul 2004 23:58:47 -0000 1.30
+++ SMTP.pm 16 Jul 2004 02:22:11 -0000 1.31
@@ -226,8 +226,13 @@
else {
my $from_parameter = join " ", @_;
$self->log(LOGINFO, "full from_parameter: $from_parameter");
- my ($from) = ($from_parameter =~ m/^from:\s*(\S+)/i)[0];
- warn "$$ from email address : [$from]\n";
+
+ my ($from) = ($from_parameter =~ m/^from:\s*(<[^>]+>)/i)[0];
+
+ # support addresses without <> ... maybe we shouldn't?
+ ($from) = "<" . ($from_parameter =~ m/^from:\s*(\S+)/i)[0] . ">"
+ unless $from;
+
if ($from eq "<>" or $from =~ m/\[undefined\]/) {
$from = Qpsmtpd::Address->new("<>");
}