| Subject: | PATCH: timeout option |
Thanks for the great module. I have attached a patch to implement a
timeout
on scp. This was against Net::SCP 0.07. Thanks again.
b.
| Subject: | Net-SCP-timeout-01.patch |
--- SCP.pm 2004-03-03 00:44:55.000000000 -0800
+++ SCP_new.pm 2005-12-02 15:13:33.000000000 -0800
@@ -9,6 +9,7 @@
use IO::Handle;
use Net::SSH qw(sshopen3);
use IPC::Open3;
+use POSIX qw(:sys_wait_h signal_h);
@ISA = qw(Exporter);
@EXPORT_OK = qw( scp iscp );
@@ -67,8 +68,31 @@
Returns false and sets the B<errstr> attribute if there is an error.
+=item timeout TIME (seconds)
+
+Must be called as an object, e.g. $scp->timeout( 10 ). Sets the maximum
+time the call to scp can take. It sets $SIG{ALRM} to control the timeout
+so do not use this if you are relying on an alarm elsewhere. If scp
+times out, then $scp->{errstr} will contain "Child Timed Out". Pass
+0 (zero) to clear the timeout (no $SIG{ALRM} used).
+
+Be sure to read the perlfunc man page about the alarm function. The time
+you pass and the actuall timeout could be off by one second.
+
=cut
+sub timeout {
+ my $self = ref($_[0]) ? shift : undef;
+ if( ! ref( $self )){
+ croak( "Sorry, timeout is OO only." );
+ }
+ if( @_ && $_[0] =~ /^(\d+)$/ ){
+ $self->{timeout} = $1;
+ }
+ return $self->{timeout};
+}
+
+
sub scp {
my $self = ref($_[0]) ? shift : {};
my($src, $dest, $interact) = @_;
@@ -91,8 +115,30 @@
( new IO::Handle, new IO::Handle, new IO::Handle );
$writer->autoflush(1);# $error->autoflush(1);
my $pid = open3($writer, $reader, $error, @cmd );
- waitpid $pid, 0;
- if ( $? >> 8 ) {
+ my $err;
+ if ( exists $self->{timeout} && $self->{timeout} ) {
+ $self->{errstr} = '';
+ my $old_alrm = $SIG{ALRM};
+ $SIG{ALRM} = sub {
+ kill SIGTERM, $pid;
+ waitpid $pid, 0;
+ $self->{errstr} = "Child Timed Out";
+ };
+ alarm $self->{timeout};
+ $err = waitpid $pid, 0;
+ alarm 0;
+ $SIG{ALRM} = $old_alrm;
+ if( $self->{errstr} ){
+ kill SIGTERM, $pid;
+ waitpid $pid, 0;
+ return 0;
+ }
+
+ } else {
+ waitpid $pid, 0;
+ $err = $?;
+ }
+ if ( $err >> 8 ) {
my $errstr = join('', <$error>);
#chomp(my $errstr = <$error>);
$self->{errstr} = $errstr;