diff --git a/URI.pm b/URI.pm index c8a168ea..ee0799ad 100644 --- a/URI.pm +++ b/URI.pm @@ -985,9 +985,14 @@ common, generic and server methods. =item B: Information about ssh is available at L. -C objects belonging to the ssh scheme support the common, -generic and server methods. In addition, they provide methods to -access the userinfo sub-components: $uri->user and $uri->password. +C objects belonging to the ssh scheme support the common, generic +and server methods. In addition, they provide methods to access the +userinfo sub-components: $uri->user and $uri->password and +$uri->c_params. + +C accepts/returns an array reference with connection +parameters as decribed on the RFC draft +C. =item B: diff --git a/URI/ssh.pm b/URI/ssh.pm index 1d47e414..3765d2d1 100644 --- a/URI/ssh.pm +++ b/URI/ssh.pm @@ -2,10 +2,83 @@ package URI::ssh; require URI::_login; @ISA=qw(URI::_login); -# ssh://[USER@]HOST[:PORT]/SRC +# ssh://[USER[:PASSWORD][;C-PARAM[,C-PARAM[,...]]]@]HOST[:PORT]/SRC +use URI::Escape qw(uri_unescape); + sub default_port { 22 } sub secure { 1 } +sub sshinfo +{ + my $self = shift; + my $old = $self->authority; + + if (@_) { + my $new = $old; + $new = "" unless defined $new; + $new =~ s/.*@//; # remove old stuff + my $si = shift; + if (defined $si) { + $si =~ s/@/%40/g; # protect @ + $new = "$si\@$new"; + } + $self->authority($new); + } + return undef if !defined($old) || $old !~ /(.*)@/; + return $1; +} + +sub userinfo +{ + my $self = shift; + my $old = $self->sshinfo; + + if (@_) { + my $new = $old; + $new = "" unless defined $new; + $new =~ s/^[^;]*//; # remove old stuff + my $ui = shift; + if (defined $ui) { + $ui =~ s/;/%3B/g; # protect ; + $new = "$ui$new"; + } + else { + $new = undef unless length $new; + } + $self->sshinfo($new); + } + return undef if !defined($old) || $old !~ /^([^;]+)/; + return $1; +} + +sub c_params { + my $self = shift; + my $old = $self->sshinfo; + if (@_) { + my $new = $old; + $new = "" unless defined $new; + $new =~ s/;.*//; # remove old stuff + my $cp = shift; + $cp = [] unless defined $cp; + $cp = [$cp] unless ref $cp; + if (@$cp) { + my @cp = @$cp; + for (@cp) { + s/%/%25/g; + s/,/%2C/g; + s/;/%3B/g; + } + $new .= ';' . join(',', @cp); + } + else { + $new = undef unless length $new; + } + $self->sshinfo($new); + } + return undef if !defined($old) || $old !~ /;(.+)/; + [map uri_unescape($_), split /,/, $1]; +} + 1;