PERL Miscellaneous - IO::Socket problem

Author

IO::Socket problem

Bigus

2004-05-14, 12:31 pm

I have a script that connects to a mailing list server to execute commands.
The code is:

====================
use strict;
use warnings;
my $email = "blah\@blah.com";
my $cmd = "some command";

# Connect to Listserv
use IO::Socket;
my $lsv = new IO::Socket::INET( PeerAddr => 'localhost',
PeerPort => 2306,
Proto => 'tcp');
$lsv or die "Connection problem :$!";

# Send command header & check return code
my $len = length($email)+length($cmd)+1;
my $bin =
pack("a*CCCa*","\r\n",int($len/256),$len-(int($len/256)*256),length($email),
$email);
$lsv->print("1B".$bin);
my $msg = $lsv->getline;
exit if $msg !~ /^250/;

# Send command
$lsv->print("$cmd\n");
my @lines = $lsv->getlines;
print "@lines";

# Close socket
close $lsv;
====================

The "send command" block is the bit I'm having problems with. The response
from the server, to the command I'm issuing, results in multiple lines so
I'm trying to catch it with the $lsv->getlines method into an array.
However, the cursor just hangs and nothing is printed. If I change the "send
command" block to:

# Send command
$lsv->print("$cmd\n");
while(my $line = $lsv->getline){
print $line;
}

That works to the extent that all the expected lines are printed but the
script seems to get stuck in the while. In others it hangs at the end of the
command response. If I stick a:

last if eof($line);

line into the while loop after the print line, it prints *only* the first
line of the command output and then exits properly.

I've been trying all sorts of things and surfing around for hours now, so am
beginning to tear my hair out. So, any solutions would be much appreciated.

Regards
Bigus

Thomas Kratz

2004-05-14, 1:31 pm

Bigus wrote:

[...]

>
> The "send command" block is the bit I'm having problems with. The response
> from the server, to the command I'm issuing, results in multiple lines so
> I'm trying to catch it with the $lsv->getlines method into an array.
> However, the cursor just hangs and nothing is printed. If I change the "send
> command" block to:
>
> # Send command
> $lsv->print("$cmd\n");
> while(my $line = $lsv->getline){
> print $line;
> }
>
> That works to the extent that all the expected lines are printed but the
> script seems to get stuck in the while. In others it hangs at the end of the
> command response.

That's because you call $lsv->getline one time to often and it blocks,
because there is nothing to read anymore.

> If I stick a:
>
> last if eof($line);
>
> line into the while loop after the print line, it prints *only* the first
> line of the command output and then exits properly.

eof($line)? Surely you mean $lsv->eof(), don't you. But this should also
block because in checking for eof you still have to read from the socket.

Have a look at IO::Select and the can_read() method. You will be able to
tell if a subsequent read will be successfull or not.

Getting eof after a safe read on the socket will tell you that the socket
has been closed.

Also have a look at the connected() method of IO::Socket and the
has_exception() method of IO::Select for checking the status for the
socket connection.

Thomas

--
open STDIN,"<&DATA";$=+=14;$%=50;while($_=(s

( #J~.> a>n~>>e~.......>r.
STDIN,$:*$=+$,+$%,0),getc)){/\./&&last;/\w| /&&( #.u.t.^..oP..r.>h>a~.e..
print,$_=$~);/~/&&++$:;/\^/&&--$:;/>/&&++$,;/</ #.>s^~h<t< ..~. ...c.^..
&&--$,;$:%=4;$,%=23;$~=$_;++$i==1?++$,:_;}__END__#....>>e>r^..>l^...>k^..

Bigus

2004-05-17, 12:35 pm

"Thomas Kratz" <ThomasKratz@REMOVEwebCAPS.de> wrote in message
news:40a4f19e.0@juno.wiesbaden.netsurf.de...
> Bigus wrote:
>
> [...]
>
response[color=darkred]
so[color=darkred]
"send[color=darkred]
the[color=darkred]
>
> That's because you call $lsv->getline one time to often and it blocks,
> because there is nothing to read anymore.
>
first[color=darkred]
>
> eof($line)? Surely you mean $lsv->eof(), don't you. But this should also
> block because in checking for eof you still have to read from the socket.
>
> Have a look at IO::Select and the can_read() method. You will be able to
> tell if a subsequent read will be successfull or not.

I can't seem to get it to work.. I'll hunt around for some more examples.

Thanks
Bigus

Thomas Kratz

2004-05-17, 1:38 pm

Bigus wrote:

>
> I can't seem to get it to work.. I'll hunt around for some more examples.

Try this [modified original script]:
(untested)

====================
use strict;
use warnings;
my $email = "blah\@blah.com";
my $cmd = "some command";

# Connect to Listserv
use IO::Socket;
my $lsv = new IO::Socket::INET( PeerAddr => 'localhost',
PeerPort => 2306,
Proto => 'tcp');
$lsv or die "Connection problem :$!";

# Send command header & check return code
my $len = length($email)+length($cmd)+1;
my $bin =
pack("a*CCCa*","\r\n",int($len/256),$len-(int($len/256)*256),length($email),
$email);
$lsv->print("1B".$bin);
my $msg = $lsv->getline;
exit if $msg !~ /^250/;

use IO::Select;
my $sel = IO::Select->new();
$sel->add($lsv);

# Send command
$lsv->print("$cmd\n");

my @lines;
while ( $sel->can_read(0.1) ) {
last if $lsv->eof;
my $line = $lsv->getline;
push @lines, $line;
}

print "@lines";

# Close socket
close $lsv;
====================

This should not block and print all lines available.

Thomas

--
open STDIN,"<&DATA";$=+=14;$%=50;while($_=(s

Bigus

2004-05-18, 8:31 pm

"Thomas Kratz" <ThomasKratz@REMOVEwebCAPS.de> wrote in message
news:40a8ef05.0@juno.wiesbaden.netsurf.de...
> Bigus wrote:
>
examples.[color=darkred]
>
> Try this [modified original script]:
> (untested)
>
> ====================
> use strict;
> use warnings;
> my $email = "blah\@blah.com";
> my $cmd = "some command";
>
> # Connect to Listserv
> use IO::Socket;
> my $lsv = new IO::Socket::INET( PeerAddr => 'localhost',
> PeerPort => 2306,
> Proto => 'tcp');
> $lsv or die "Connection problem :$!";
>
> # Send command header & check return code
> my $len = length($email)+length($cmd)+1;
> my $bin =
>
pack("a*CCCa*","\r\n",int($len/256),$len-(int($len/ 256)*256),length($email),

> $email);
> $lsv->print("1B".$bin);
> my $msg = $lsv->getline;
> exit if $msg !~ /^250/;
>
> use IO::Select;
> my $sel = IO::Select->new();
> $sel->add($lsv);
>
> # Send command
> $lsv->print("$cmd\n");
>
> my @lines;
> while ( $sel->can_read(0.1) ) {
> last if $lsv->eof;
> my $line = $lsv->getline;
> push @lines, $line;
> }
>
> print "@lines";
>
> # Close socket
> close $lsv;
> ====================
>
> This should not block and print all lines available.

Thanks but unfortunately not.. it exits after the first line and prints that
out. I suspect that an eof marker is being sent at the end of each line of
output from the mailing list system. Actually, just tried commenting out the
"last if.. eof" line and it still prints out the first line and exits.

Regards
Bigus

Thomas Kratz

2004-05-19, 12:32 pm

Bigus wrote:

[snipped code]
>
>
> Thanks but unfortunately not.. it exits after the first line and prints that
> out. I suspect that an eof marker is being sent at the end of each line of
> output from the mailing list system. Actually, just tried commenting out the
> "last if.. eof" line and it still prints out the first line and exits.

That means can_read returns no readable handle on the second loop. Try to
increase the timeout given to can_read or enter the while loop again after
a sleeping period.

Anyway: The server has to have a method of indicating, whether the client
should read more than one line (like in SMTP or NNTP). i. e. a '-' after
the three digits of the return code. You should be able to tell whether
you have read all data or not, because you won't get an eof on the handle.

What protocol is the server using?

Thomas

--
open STDIN,"<&DATA";$=+=14;$%=50;while($_=(s

Bigus

2004-05-19, 4:31 pm

"Thomas Kratz" <ThomasKratz@REMOVEwebCAPS.de> wrote in message
news:40ab7d46.0@juno.wiesbaden.netsurf.de...
> Bigus wrote:
>
> [snipped code]
that[color=darkred]
of[color=darkred]
the[color=darkred]
>
> That means can_read returns no readable handle on the second loop. Try to
> increase the timeout given to can_read or enter the while loop again after
> a sleeping period.
>
> Anyway: The server has to have a method of indicating, whether the client
> should read more than one line (like in SMTP or NNTP). i. e. a '-' after
> the three digits of the return code. You should be able to tell whether
> you have read all data or not, because you won't get an eof on the handle.
>
> What protocol is the server using?

TCP. You've helped me alot as it is, but you could probably try it yourself
if you were so inclined. ie: if you register a password here:

http://www.jiscmail.ac.uk/cgi-bin/webadmin?GETPW1=LMGT1

(you get a confirmation mail with a link you have to click on)

and then put your email address & password in the 3rd & 4th lines below,
removing the angle brackets of course. I've set the list to allow a "public"
review, so you don't need to be a list member to see the header.

If you want to see what the review command should return then substitute the
lines from Use IO::Select down to print "@lines" with:

$lsv->print("$cmd\n");
while (my $line = $lsv->getline) {
print $line;
}

and it'll print the lines & then block.

use strict;
use warnings;
my $email = '<emailaddresshere>';
my $cmd = "review sw-test msg pw=<passwordhere>";

# Connect to Listserv
use IO::Socket;
my $lsv = new IO::Socket::INET( PeerAddr => 'localhost',
PeerPort => 2306,
Proto => 'tcp');
$lsv or die "Connection problem :$!";

# Send command header & check return code
my $len = length($email)+length($cmd)+1;
my $bin =
pack("a*CCCa*","\r\n",int($len/256),$len-(int($len/256)*256),length($email),
$email);
$lsv->print("1B".$bin);
my $msg = $lsv->getline;
exit if $msg !~ /^250/;

use IO::Select;
my $sel = IO::Select->new();
$sel->add($lsv);

# Send command
$lsv->print("$cmd\n");

my @lines;
while ( $sel->can_read(0.1) ) {
#last if $lsv->eof;
my $line = $lsv->getline;
push @lines, $line;
}

print "@lines";

# Close socket
close $lsv;

exit;

Regards
Bigus

Sponsored Links