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;

Reply via email to