The following patch has been applied and should show up in URI-1.25
when released. It makes sure we use the last '@' found in the
'authority' component of the URI as the 'userinfo' delimiter.
Regard,
Gisle
Index: URI/_server.pm
===================================================================
RCS file: /cvsroot/libwww-perl/uri/URI/_server.pm,v
retrieving revision 4.3
retrieving revision 4.4
diff -u -p -u -r4.3 -r4.4
--- URI/_server.pm 15 May 2001 03:41:38 -0000 4.3
+++ URI/_server.pm 18 Aug 2003 18:10:37 -0000 4.4
@@ -13,7 +13,7 @@ sub userinfo
if (@_) {
my $new = $old;
$new = "" unless defined $new;
- $new =~ s/[EMAIL PROTECTED]@//; # remove old stuff
+ $new =~ s/.*@//; # remove old stuff
my $ui = shift;
if (defined $ui) {
$ui =~ s/@/%40/g; # protect @
@@ -21,7 +21,7 @@ sub userinfo
}
$self->authority($new);
}
- return undef if !defined($old) || $old !~ /^([EMAIL PROTECTED])@/;
+ return undef if !defined($old) || $old !~ /(.*)@/;
return $1;
}
@@ -32,7 +32,7 @@ sub host
if (@_) {
my $tmp = $old;
$tmp = "" unless defined $tmp;
- my $ui = ($tmp =~ /^([EMAIL PROTECTED]@)/) ? $1 : "";
+ my $ui = ($tmp =~ /(.*@)/) ? $1 : "";
my $port = ($tmp =~ /(:\d+)$/) ? $1 : "";
my $new = shift;
$new = "" unless defined $new;
@@ -43,7 +43,7 @@ sub host
$self->authority("$ui$new$port");
}
return undef unless defined $old;
- $old =~ s/[EMAIL PROTECTED]@//;
+ $old =~ s/.*@//;
$old =~ s/:\d+$//;
return uri_unescape($old);
}
@@ -77,7 +77,7 @@ sub host_port
my $old = $self->authority;
$self->host(shift) if @_;
return undef unless defined $old;
- $old =~ s/[EMAIL PROTECTED]@//; # zap userinfo
+ $old =~ s/.*@//; # zap userinfo
$old =~ s/:$//; # empty port does not could
$old .= ":" . $self->port unless $old =~ /:/;
$old;