Phoenix.pm: socket, select & sysread questions
Scott Walters
phaedrus at illogics.org
Fri Dec 28 00:48:28 CST 2001
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;
> }
> }
> }
>
>
>
More information about the Phoenix-pm
mailing list