Phoenix.pm: socket, select & sysread questions

[Scott Walters]

Nevermind, I'll just accept the fact that something is tickling select(),
this it 'tis and nothing more, I'll mearly use non-blocking sockets.
I'm only getting a false positive every few seconds *boggle*.

cheers,
-scott

On Thu, 27 Dec 2001, Scott Walters wrote:

> 
> Sorry to bug you folks, but I'm stumped. Normally when I'm completely stuck, I
> nuke the offending code and recode it differently. In this case, select() is the
> only thing (aside form polling - yuck) that can wait for input on one of several
> file handles.
> 
> I'm trying to tie two daemons together. This script needs to seriously munge
> the output of each for the consuption of the other, but that isn't done yet.
> Haven't gotten that far. I'm stuck on the async IO aspect still...
> 
> select() should modify it's first arg to only have bits set that correspond
> to ready input channels, and I should be able to test that modified arg and find
> out weither any given input has data I can read from without blocking.
> 
> I've got it set so that if it spends 3 seconds trying to read input, the
> alarm goes off, and the $SIG{ALRM} handler gives me a quick line-number
> backtrace. At the comment below ending in '!!!', it keeps entering that
> routine when it shouldn't. The code works, basicly, but continiously
> gets apparently false alerts.
> 
> What really gets my goat is that the code is stolen from the man perlfunc
> page =P
> 
> Polling isn't an option. The CPU is too slow, theres a load of other
> stuff running on the machine, it's only got 32 megs ram, and I need
> low latency here. Threads might work, but I don't want to have to
> learn Perl threads unless I have to or someone is there to hold my
> hand ;)
> 
> Does anyone see offhand what I'm doing wrong here?
> 
> Thanks,
> -scott
> 
> #!/usr/bin/perl
> 
> 
> use Socket;
> use Carp qw(confess);
> 
> $irchost = 'mesa.az.us.undernet.org';
> 
> $|=1;
> $SIG{ALRM} = sub { print join "\n", map { (caller($_))[2]; } 0..10; print "\n"; die; };
> 
> # mud
> socket(MUD, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
> connect(MUD, sockaddr_in(2000, inet_aton("weehours.net"))) or die;
> select((select(MUD),$|=1)[0]) or die;
> print MUD "guest\n";
> print MUD "\n";
> $bmud = simbuf();
> print "debug: filno for MUD: ", fileno(MUD), "\n";
> 
> # irc
> socket(IRC, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
> connect(IRC, sockaddr_in(6660, inet_aton($irchost))) or die;
> select((select(IRC),$|=1)[0]) or die;
> $rnd=int(rand()*10);
> type("USER phaedrus . . phaedrus\@starlight.omega2.com\n");
> type("NICK weehours$rnd\n");
> $birc = simbuf();
> print "debug: filno for IRC: ", fileno(IRC), "\n";
> 
> READLOOP: while(1) {
>   $rmud=''; vec($rmud,fileno(MUD),1) = 1;
>   $rirc=''; vec($rirc,fileno(IRC),1) = 1;
>   $rout='';
>   vec($rout,fileno(IRC),1) = 1;
>   vec($rout,fileno(MUD),1) = 1;
> 
>   # this is the select that should be leaving only bits set that correspond to ready inputs
>   next READLOOP unless select($rout, undef, undef, undef);
> 
>   if($rout&$rirc) { eval {
>     # we keep entering this block when we shouldnt, and blocking for input!!!
>     alarm 3;
>     sysread IRC, $buf, 8192;
>     $birc->('write', $buf);
>     while($buf = $birc->('read')) {
>       $buf = fromirc($buf);
>       syswrite MUD, $buf, length($buf) if($buf);
>     }
>     alarm 0;
>   } }
> 
>   if($rout&$rmud) { eval {
>     alarm 3;
>     sysread MUD, $buf, 8192;
>     $bmud->('write', $buf);
>     while($buf = $bmud->('read')) {
>       $buf = frommud($buf);
>       syswrite IRC, $buf, length($buf) if($buf);
>     } 
>     alarm 0;
>   } }
> }
> 
> sub fromirc {
>   # filter input from IRC for output to MUD
>   my $buf = shift;
>   print STDOUT $buf, "\n";
>   if($buf =~ m/ 376 /) {
>     type("MODE weehours$rnd +i\n");
>     type("JOIN #mud\n");
>     return '';
>   } elsif($buf =~ m/PING :(.+)/) {
>     type("PONG $1\n");
>     return '';
>   }
>   #} elsif($buf =~ m/$irchost:(.*)!(.*)PRIVMSG #(.*) :(.*)/o) {
>   #  #substitute {:%1!%2PRIVMSG #%4 :%3} {%1 says: %3}
>   #  return "$1 says: %3\n";
>   #}
>   return "say $buf\n";
> }
> 
> sub frommud {
>   my $buf = shift;
>   if($buf =~ m/^([A-Z][a-z]+) tells you in common: (.*)/) {
>     # return "PRIVMSG #mud :$1 says, $2\n";
> print "debug: tell from mud: $2\n";
>     return "$2\n";
>   }
>   return '';
> }
> 
> sub type ($) {
>   my $str = shift; syswrite IRC, $str, length($str); print $str;
> }
> 
> # this gives us a nice little buffering capability, so we can feed it
> # all of the data we get in, and then get only whole lines if a whole line
> # is available.
> 
> sub simbuf {
>   my $buf;
>   return sub {
>     my $act=shift;
>     if($act eq 'read') {
>       $buf =~ s/^(.*)\n//; return $1;
>     } elsif($act eq 'write') {
>       $buf .= shift;
>     }
>   }
> }
> 
> 
>