Handle SSH URIs with connection parameters

URI.pm

@@ -985,9 +985,14 @@ common, generic and server methods.
 =item B<ssh>:
 
 Information about ssh is available at L<http://www.openssh.com/>.
-C<URI> 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<URI> 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<c_params> accepts/returns an array reference with connection
+parameters as decribed on the RFC draft
+C<draft-ietf-secsh-scp-sftp-ssh-uri-04.txt>.
 
 =item B<urn>:
 

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;