| Subject: | PATCH: Another port patch for the wishlist |
This is my patch for adding a port option into Net::SCP, documentation
included.
Also I fixed some spelling from the documentation, and cleaned up a
little. The "clean ups" can be considered a matter of style so feel free
to disregard them.
Thank you.
| Subject: | SCP-port.diff |
--- /usr/local/share/perl/5.10.0/Net/SCP.pm 2007-10-27 08:23:02.000000000 +0900
+++ SCP.pm 2009-10-03 16:36:10.000000000 +0900
@@ -27,15 +27,30 @@
#procedural interface
use Net::SCP qw(scp iscp);
scp($source, $destination);
- iscp($source, $destination); #shows command, asks for confirmation, and
- #allows user to type a password on tty
+
+ # interactive mode
+ iscp($source, $destination); # Shows command, asks for confirmation, and
+ # Allows user to type a password on tty.
+
+ # non-standard remote port
+ scp($source, $destination, $port);
+ iscp($source, $destination, $port);
#OO interface
$scp = Net::SCP->new( "hostname", "username" );
+
+
#with named params
- $scp = Net::SCP->new( { "host"=>$hostname, "user"=>$username } );
+ $scp = Net::SCP->new( {
+ host => $hostname,
+ user => $username,
+ port => $port,
+ interactive => 1,
+ } );
+
$scp->get("filename") or die $scp->{errstr};
$scp->put("filename") or die $scp->{errstr};
+
#tmtowtdi
$scp = new Net::SCP;
$scp->scp($source, $destination);
@@ -46,6 +61,7 @@
$scp->cwd("/dir");
$scp->size("file");
$scp->get("file");
+ $scp->port($port);
=head1 DESCRIPTION
@@ -55,10 +71,10 @@
=over 4
-=item scp SOURCE, DESTINATION
+=item scp SOURCE, DESTINATION [, PORT ]
Can be called either as a subroutine or a method; however, the subroutine
-interface is depriciated.
+interface is deprecated.
Calls scp in batch mode, with the B<-B> B<-p> B<-q> and B<-r> options.
Returns false upon error, with a text error message accessable in
@@ -70,21 +86,28 @@
sub scp {
my $self = ref($_[0]) ? shift : {};
- my($src, $dest, $interact) = @_;
- my $flags = '-p';
- $flags .= 'r' unless &_islocal($src) && ! -d $src;
+ my($src, $dest, $port, $interact) = @_;
+ my @flags = ('-p');
+ push @flags, '-r' unless &_islocal($src) && ! -d $src;
+
+ if( ( defined ($port) && _isnumber($port) )
+ || ( defined( $self->{port} ) && _isnumber($self->{port}) ) ) {
+ $port = $self->{port} if $self->{port};
+ push @flags, '-P',$port;
+ }
+
my @cmd;
if ( ( defined($interact) && $interact )
|| ( defined($self->{interactive}) && $self->{interactive} ) ) {
- @cmd = ( $scp, $flags, $src, $dest );
+ @cmd = ( $scp, @flags, $src, $dest );
print join(' ', @cmd), "\n";
unless ( &_yesno ) {
$self->{errstr} = "User declined";
return 0;
}
} else {
- $flags .= 'qB';
- @cmd = ( $scp, $flags, $src, $dest );
+ push @flags, '-q', '-B';
+ @cmd = ( $scp, @flags, $src, $dest );
}
my($reader, $writer, $error ) =
( new IO::Handle, new IO::Handle, new IO::Handle );
@@ -102,10 +125,10 @@
}
}
-=item iscp SOURCE, DESTINATION
+=item iscp SOURCE, DESTINATION [, PORT ]
Can be called either as a subroutine or a method; however, the subroutine
-interface is depriciated.
+interface is deprecated.
Prints the scp command to be execute, waits for the user to confirm, and
(optionally) executes scp, with the B<-p> and B<-r> flags.
@@ -117,10 +140,15 @@
sub iscp {
if ( ref($_[0]) ) {
my $self = shift;
- $self->{'interactive'} = 1;
+ $self->{interactive} = 1;
$self->scp(@_);
} else {
- scp(@_, 1);
+ if ( @_ > 2 ) {
+ scp( @_, 1 );
+ }
+ else {
+ scp( @_, undef, 1 );
+ }
}
}
@@ -134,19 +162,24 @@
shift !~ /^[^:]+:/
}
+sub _isnumber {
+ shift =~ /^\d+$/
+}
+
=back
=head1 METHODS
=over 4
-=item new HOSTNAME [ USER ] | HASHREF
+=item new HOSTNAME [ USER ] [ PORT ] [ INTERACTIVE ] | HASHREF
This is the constructor for a new Net::SCP object. You must specify a
hostname, and may optionally provide a user. Alternatively, you may pass a
hashref of named params, with the following keys:
host - hostname
+ port - host's port
user - username
interactive - bool
cwd - current working directory on remote server
@@ -161,10 +194,11 @@
$self = shift;
} else {
$self = {
- 'host' => shift,
- 'user' => ( scalar(@_) ? shift : '' ),
- 'interactive' => 0,
- 'cwd' => '',
+ host => shift,
+ user => ( scalar(@_) ? shift : '' ),
+ port => ( scalar(@_) ? shift : '' ),
+ interactive => ( scalar(@_) ? shift : 0 ),
+ cwd => '',
};
}
bless($self, $class);
@@ -178,7 +212,18 @@
sub login {
my($self, $user) = @_;
- $self->{'user'} = $user if $user;
+ $self->{user} = $user if $user;
+}
+
+=item port [PORT]
+
+Sets the remote host port.
+
+=cut
+
+sub port {
+ my($self, $port) = @_;
+ $self->{port} = $port if $port;
}
=item cwd CWD
@@ -189,7 +234,7 @@
sub cwd {
my($self, $cwd) = @_;
- $self->{'cwd'} = $cwd || '/';
+ $self->{cwd} = $cwd || '/';
}
=item get REMOTE_FILE [, LOCAL_FILE]
@@ -201,10 +246,10 @@
sub get {
my($self, $remote, $local) = @_;
- $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//;
+ $remote = $self->{cwd}. "/$remote" if $self->{cwd} && $remote !~ /^\//;
$local ||= basename($remote);
- my $source = $self->{'host'}. ":$remote";
- $source = $self->{'user'}. '@'. $source if $self->{'user'};
+ my $source = $self->{host}. ":$remote";
+ $source = $self->{user}. '@'. $source if $self->{user};
$self->scp($source,$local);
}
@@ -220,16 +265,22 @@
sub mkdir {
my($self, $directory) = @_;
- $directory = $self->{'cwd'}. "/$directory"
- if $self->{'cwd'} && $directory !~ /^\//;
- my $host = $self->{'host'};
- $host = $self->{'user'}. '@'. $host if $self->{'user'};
+ $directory = $self->{cwd}. "/$directory"
+ if $self->{cwd} && $directory !~ /^\//;
+ my $host = $self->{host};
+ $host = $self->{user}. '@'. $host if $self->{user};
my($reader, $writer, $error ) =
( new IO::Handle, new IO::Handle, new IO::Handle );
$writer->autoflush(1);
- my $pid = sshopen3( $host, $writer, $reader, $error,
- '/bin/mkdir', '-p ', shell_quote($directory) );
+
+ #my $pid = sshopen3( $host, $writer, $reader, $error, '/bin/mkdir', '-p ', shell_quote($directory) );
+ my @ssh_args = ( $host, $writer, $reader, $error );
+ push @ssh_args, '-p', $self->{port} if defined $self->{port} && _isnumber($self->{port});
+ push @ssh_args, '/bin/mkdir', '-p ', shell_quote($directory);
+
+ my $pid = sshopen3(@ssh_args);
waitpid $pid, 0;
+
if ( $? >> 8 ) {
chomp(my $errstr = <$error> || '');
$self->{errstr} = $errstr || "mkdir exited with status ". ($?>>8);
@@ -252,16 +303,21 @@
sub size {
my($self, $file) = @_;
- $file = $self->{'cwd'}. "/$file" if $self->{'cwd'} && $file !~ /^\//;
- my $host = $self->{'host'};
- $host = $self->{'user'}. '@'. $host if $self->{'user'};
+ $file = $self->{cwd}. "/$file" if $self->{cwd} && $file !~ /^\//;
+ my $host = $self->{host};
+ $host = $self->{user}. '@'. $host if $self->{user};
my($reader, $writer, $error ) =
( new IO::Handle, new IO::Handle, new IO::Handle );
$writer->autoflush(1);
- #sshopen2($host, $reader, $writer, 'wc', '-c ', shell_quote($file) );
- my $pid =
- sshopen3($host, $writer, $reader, $error, 'wc', '-c ', shell_quote($file) );
+
+ #sshopen3($host, $reader, $writer, 'wc', '-c ', shell_quote($file) );
+ my @ssh_args = ( $host, $writer, $reader, $error );
+ push @ssh_args, '-p', $self->{port} if defined $self->{port} && _isnumber($self->{port});
+ push @ssh_args, 'wc', '-c ', shell_quote($file);
+
+ my $pid = sshopen3(@ssh_args);
waitpid $pid, 0;
+
if ( $? >> 8 ) {
chomp(my $errstr = <$error>);
$self->{errstr} = $errstr || "wc exited with status ". $?>>8;
@@ -287,9 +343,9 @@
sub put {
my($self, $local, $remote) = @_;
$remote ||= basename($local);
- $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//;
- my $dest = $self->{'host'}. ":$remote";
- $dest = $self->{'user'}. '@'. $dest if $self->{'user'};
+ $remote = $self->{cwd}. "/$remote" if $self->{cwd} && $remote !~ /^\//;
+ my $dest = $self->{host}. ":$remote";
+ $dest = $self->{user}. '@'. $dest if $self->{user};
warn "scp $local $dest\n" if $DEBUG;
$self->scp($local, $dest);
}