Event on IRIX platform

[email protected] (Trey Graves)
Newsgroups perl.loop
Message-ID <[email protected]> 
Hi,

I am having trouble getting a perl script that uses Event.pm to work
correctly on the IRIX platform. I have attached the code. (It's a
prototype, and yes, it's mostly plagiarized. ;) First the program opens
up a listen port. Then it registers an event on the listen port and
goes into loop(). The problem is that the event goes off (even though
nothing has tried to connect) and it blocks in the accept(). I have
tried this on solaris and linux and had no problems.

We are running Event-0.76 at work. Also, perl5.005_02 and IRIX
6.5.?. I would upgrade to the latest version of Event (0.78?) but we
have to go through a lengthy ;( security proceedure to get code in.
Before I do that, I would like to know if this is a known problem and
if there's a fix.

Another option I was wondering about: it looks like the poll() is being
used over the select(). We have a C library that is similar to Event
at work (although not as robust as Event) and it sits in a select()
call.
Would that make any difference? I say that b/c I found one email on
the mailing list that indicated IRIX implements poll() differently.

On Thu, Jul 06, 2000 at 10:19:02AM +0200, [email protected]
wrote:
> Although my previous patch works, it doesn't solve the real problem.
> I have tested a bit more and found out that you cannot set POLLHUP in the
> events field on IRIX. This will cause an immediate return by poll which
> causes the excessive CPU usage.
> ...

How would one recompile Event.pm with select over poll? (I couldn't find
where the HAS_POLL was being set.)

Thanks!

Trey
acceptor.pl (application/x-perl, 2.5 KB) 
#!/usr/bin/perl
use strict;
use Event qw(loop unloop);
use Event::Watcher qw(R W T);

use IO::Socket;
use Tie::RefHash;

use encode_decode_ping;

my $port = 7676;
my $wait_for_accept_limit = 2*60*60;
my $ping_timeout = 30;

# Listen to port.
my $server = IO::Socket::INET->new(LocalPort => $port,
				   Listen    => 20,
				   Reuse     => 1)
  or die "Can't make server socket: $@\n";

# initialize acceptor
my $accept_watcher = Event->io(disc => 'accept',
			       fd=>$server,
			       poll => 'r',
			       prio => 4, # normal
			       cb => \&accept_handler,
			       max_cb_tm => 5,
			       timeout => $wait_for_accept_limit,
			       timeout_cb => \&too_long_waiting_on_accept);

# enter the main event loop
exit loop();
# end of main()

sub too_long_waiting_on_accept {
  print "no accept for $wait_for_accept_limit seconds; exiting\n";
  unloop();
}

sub ping_timeout_handler {
  my ($ping_event) = @_;
  my $ping_fd = $ping_event->w->fd;
  print "no ping for $ping_timeout seconds; closing connection\n";
  $ping_fd->close();
  $ping_event->w->stop();
}

sub accept_handler {
  my ($accept_event) = @_;
  my $accept_fd = $accept_event->w->fd;

  # accept the new connection: this is now the 
  # ping port (socket, file descriptor, ... 
  # whatever you want to call it)
  my $ping_fd = $accept_fd->accept();

  # initialize ping (read) event
  my $ping_event = Event->io(disc => "remote_name",
			     fd=>$ping_fd,
			     poll => 'r',
			     prio => 2,
			     cb => \&ping_handler,
			     timeout => $ping_timeout,
			     timeout_cb => \&ping_timeout_handler);

  @$ping_event{'ibuf','obuf'} = ('')x2;
  $ping_event->{readcb} = \&reply_to_ping;

  print $ping_fd "hello\n";
  print "got accept\n";
}

sub ping_handler {
  my ($e) = @_;
  my $w = $e->w;

  my  $got = $e->got;

  #print "got ping \"$got\"\n";
  #sleep(5);

  if ($e->got & T) {
    close $w->fd;
    $w->cancel;
    return;
  }
  if ($e->got & R) {
    my $buf='';
    my $num_bytes = sysread $w->fd, $buf, 8192;
    #print "num_bytes = $num_bytes\n";
    if (!$num_bytes) {
      print "EOF\n";
      close $w->fd;
      $w->cancel;
      return;
    }
    warn "'$w->desc' R[".sanitize($buf)."]\n"
      if $w->debug+$Event::DebugLevel >= 3;

    $w->{ibuf} .= $buf;
    $w->{obuf} .= $w->{readcb}->($e);
  }
} 

sub reply_to_ping {

  my ($e) = @_;
  my $w = $e->w;
  my $ret='';

  # print "ibuf = $w->{ibuf}\n";

  while ($w->{ibuf} =~ s/^(.*?)\n//) {
    print "received ", $1, "\n";
    $ret = decode_ping($1);
    syswrite($w->fd, 
	     $ret,
	     length($ret));  
  }
};
encode_decode_ping.pm (text/plain, 820 B) 
#!/usr/bin/perl -w

use strict;

my $ping_msg;

# fixme
my $start_format = "%10s %10d";
my $ping_format  = "%10s %10d";
my $stop_format  = "%10s %10d";

sub encode_ping {

  my $ping_type = shift;
  my $one_up = shift;

  if ($ping_type =~ /start/) {
    $ping_msg = sprintf ($start_format, $ping_type, $one_up);
  } elsif ($ping_type =~ /ping/) {
    $ping_msg = sprintf ($ping_format, $ping_type, $one_up);
  } elsif ($ping_type =~ /stop/) {
    $ping_msg = sprintf ($stop_format, $ping_type, $one_up)
  }

  return  $ping_msg;

}

sub decode_ping {

  my $ping_type = shift;
  my $return_msg;

  if ($ping_type =~ /start/) {
    $return_msg = "starting";
  } elsif ($ping_type =~ /ping/) {
    $return_msg = "pong";
  } elsif ($ping_type =~ /stop/) {
    $return_msg = "stopping";
  }

  return $return_msg . "\n";
}
pinger.pl (application/x-perl, 1.5 KB) 
#!/usr/bin/perl
use strict;
use Event qw(loop unloop);
use Event::Watcher qw(R W T);

use IO::Socket;
use Tie::RefHash;
use encode_decode_ping;

my $port = 7676;
my $timer_event;
my $i = 1;

my $machine = "localhost";

my ($ping_msg, $ping_type);

# Listen to port.
my $server = IO::Socket::INET->new(Proto => "tcp",
				   PeerAddr => $machine,
				   PeerPort => $port)
  or die "Can't connect to : $@\n";

# initialize acceptor
my $accept_watcher = Event->io(disc => 'connect',
			       fd=>$server,
			       poll => 'r',
			       prio => 2, # normal
			       cb => \&ping_result_handler);

$ping_type = "start";
send_ping();
$ping_type = "ping";
    
# enter the main event loop
exit loop();
# end of main()

sub ping_result_handler {
  my ($e) = @_;
  my $w = $e->w;

  my  $got = $e->got;

  # print "got read \"$got\"\n";

  if ($e->got & T) {
    close $w->fd;
    $w->cancel;
    return;
  }
  if ($e->got & R) {
    my $buf='';
    my $num_bytes = sysread $w->fd, $buf, 8192;
    # print "num_bytes = $num_bytes\n";
    if (!$num_bytes) {
      print "EOF\n";
      close $w->fd;
      $w->cancel;
      $timer_event->cancel;
      return;
    }

    print "received $buf";

  }

} 

sub send_ping {
  
  $ping_msg = encode_ping($ping_type, $i++);

  print "sending \"$ping_msg\"\n";

  $ping_msg .= "\n";

  syswrite($server, 
	   $ping_msg,
	   length($ping_msg));
  
  $timer_event = Event->timer(disc => 'timeout',
			      prio => 4, # normal
			      cb => \&send_ping,
			      interval => 10,
			      repeat => 0);
  
}
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.