Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

IO::Socket::INET timeout

Status
Not open for further replies.

Andyfives

Programmer
Feb 22, 2002
46
DK
Hi, I do have more question....

I want to connect to a remote host and have a backup host if there is a problem in the connection.

I can use my template-toolkit code to call the fallback IP but there is a time delay of 30 seconds. This is too long.

I am trying to set a timeout of around 2-3 seconds and notice that the IO::Socket::INET timeout value is doing nothing.

Reading up I found some detail on using an alarm method, but my small knowledge of perl is hindering me yet again. (incorrect) syntax below,

:-(

Code:
package plugin::SterlingDCC;

use base qw( Template::Plugin );
use Template::Plugin;
use IO::Socket;

use lib::SkyObject;

use vars qw( @ISA );
@ISA        = qw( Template::Plugin lib::SkyObject );

#! /usr/bin/perl -w
#----------------

sub getResp {
    my $timeout = 3;
    my $self            = shift;
    my %params            = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
    my $reqXML = $params{myReqXML} . \n;
    my $resp="";

    $SIG{ALRM} = \&timed_out;
    eval {
        alarm ($timeout);
        #open socket
        my $sock = new IO::Socket::INET (PeerAddr => $params{myURL},
            PeerPort => $params{myPort},
            Proto => 'tcp',
            );
    
        print $sock "$reqXML";
        $sock->autoflush(1); # so output gets there right away
        while (defined ($myline = <$sock>)) {
            $resp = $resp . $myline;
        }
        alarm (0);
        close($sock);
    };
    $resp;
};

sub timed_out {
  return (0);
}

1;

I am sure I have been close to getting it to work somewhere along the line, but not sure where... might be the parameter variables are not being recognised in the eval...

Any help on this would be really great.

Thanks in advance

Andy
 
what happens when you use the above code?

------------------------------------------
- Kevin, perl coder unexceptional! [wiggle]
 
Hi KevinADC... (again :) )

Not alot to be honest. A blank page. I've changed it around a few times and managed to output the "failed" return value of 0. That may have been the closest I have got, but it seemed to just fall into the 3 second alarm process every time and then fail.

I have not been able to get a successful connection when including this alarm, eval stuff.

Andy
 
well, this line is not correct:

print $sock "$reqXML";

maybe should be:

print $sock, $reqXML;

this other line is also suspect:

my $reqXML = $params{myReqXML} . \n;

\n should probably be double-quoted





------------------------------------------
- Kevin, perl coder unexceptional! [wiggle]
 
hmm ok I will give that a go, but both these lines worked before I placed the eval & alarm code in.

Thanks for the quick response..
 
Hi

when trying the following code I get an error "Can't call method "autoflush" on an undefined value at blar blar line 40" :-

Code:
sub getResp {
	
	my $timeout = 3;
	# STILL TO DO need to pull in the XML from the template
	my $self			= shift;
	my %params			= (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
	my $reqXML = $params{myReqXML} . "\n";
	$resp="";

	$SIG{ALRM} = \&timed_out;
	eval {
		alarm ($timeout);
		#open socket
		my $sock = new IO::Socket::INET (PeerAddr => "213.190.134.240",
			PeerPort => $params{myPort},
			Proto => 'tcp',
			);

		# send xml request
		print $sock $reqXML;
		$sock->autoflush(1); # so output gets there right away
	
		alarm (0);
	};
	#receive and print response
	
	while (defined ($myline = <$sock>)) {
		$resp = $resp . $myline;
	}
	close($sock);

	
	
	return $resp;
};


sub timed_out {
  return (0);
}


1;
 
Seems I could have a problem with the platform we are using and/or the version of perl we have. We have a windows setup. I may have to rethink my strategy.. Do you know what else I could use to get this to do what I want?

 
Sorry, no I don't.

------------------------------------------
- Kevin, perl coder unexceptional! [wiggle]
 
Kevin, Thanks for your help anyhow! I'm going to have a little rethink
 
Hi

Finally I have managed to get this to work using "blocking". We are using ActivePerl here and found out the alarm function does not work.

Please don't ask me how this solution works, but I managed to piece it together from various sources.


Code:
package plugin::SterlingDCCNew;

use base qw( Template::Plugin );
use Template::Plugin;
use IO::Socket; 
use IO::Select; 
use lib::SkyObject;

use vars qw( @ISA );
@ISA		= qw( Template::Plugin lib::SkyObject );

#! /usr/bin/perl -w
#----------------


BEGIN { 
   # This nonsense is needed in 5.6.1 and earlier 
   
   if( $^O eq 'MSWin32' ) { 
      *EWOULDBLOCK = sub () { 10035 }; 
      *EINPROGRESS = sub () { 10036 }; 
      *IO::Socket::blocking = sub { 
          my ($self, $blocking) = @_; 
          my $nonblocking = $blocking ? "0" : "1"; 
          ioctl($self, 0x8004667e, $nonblocking); 
      }; 
   } else { 
      require Errno; 
      import  Errno qw(EWOULDBLOCK EINPROGRESS); 
   } 

} 


sub getResp {

	my $self			= shift;
	my %params			= (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
	my $reqXML = $params{myReqXML} . \n;
	my $addr = inet_aton($params{myURL}) or warn("inet_aton: $!"), next; 
	my $sock = IO::Socket::INET->new(Proto=>'tcp') or die "socket: $@"; 

	defined($sock->blocking(0)) or die "Couldn't set nonblocking: $^E"; 

	my $sockaddr = sockaddr_in($params{myPort}, $addr) or die; 

	$sock->connect($sockaddr) or 
		$! == EWOULDBLOCK or $! == EINPROGRESS or 
		die sprintf "connect: %d, %s", $!, $^E; 

	() = IO::Select->new($sock)->can_write(1) 
		or return(0); 

	defined($sock->blocking(1)) or die "Couldn't set blocking: $^E"; 

	$resp="";

	# send xml request
	print $sock "$reqXML";

	#receive and print response
	$sock->autoflush(1); # so output gets there right away
	while (defined ($myline = <$sock>)) {
		$resp = $resp . $myline;
	}

	close($sock);
	return $resp;
}

1;

COYS!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top