eval 'exec perl -x $0 ${1+"$@"}' # -*-perl-*-
  if 0;
#!perl -w
#
# ======================================================================
# This file is Copyright 1998,1999 by the Purdue Research Foundation and
# may only be used under license.  For terms of the license, see the
# file named COPYRIGHT included with this software release.
# AAFID is a trademark of the Purdue Research Foundation.
# All rights reserved.
# ======================================================================
#
# Comm::Conn package
#
# AAFID project, COAST Laboratory, CERIAS, 1998-1999.
#
# Frederic Dumont, 1998-1999
# Diego Zamboni, 1999
#
# $Id: Conn.pm,v 1.4 1999/09/03 17:08:57 zamboni Exp $
#
# NOTE: This file is in Perl's POD format. For more information, see the 
#       manual page for perlpod(1).
#

=head1 NAME
  
  Conn - Check that a set of handles are still responding.

=head1 SYNOPSIS

=head2 Server code

     use Comm::Conn;
     use Comm::Reactor;
     use IO::Socket;

     Comm::Conn::init();

     unlink "toto";
     $fa=new IO::Socket::UNIX(Local=>"toto",Listen=>1);

     sub cb {
       ($fh, $msg)=@_;
       if (!defined($msg)) {
	 print "Connection closed...\n";
	 Comm::Conn::remove_handle($fh);
	 return;
       }
       if ($msg eq "quit") {
	 print "Bye\n";
	 unlink "toto";
	 exit 0;
       }
       print "Msg: $msg\n";
       Comm::Conn::send_message($fh,"Ok");
     }

     sub login {
       ($fh)=@_;
       my $nfh=$fh->accept();
       Comm::Conn::add_handle($nfh, \&cb);
       Comm::Conn::send_message($nfh, "Got your connection.");
     }

     Comm::Reactor::add_acceptor($fa, \&login);

     print "Server ready.\n";
     Comm::Reactor::loop();

=head2 Client code

     use Comm::Conn;
     use Comm::Reactor;
     use IO::Socket;
     use IO::Handle;

     Comm::Conn::init();

     sub cb {
       ($fh, $msg) = @_;
       if (!defined($msg)) {
	 Comm::Conn::remove_handle($fh);
	 Comm::Reactor::flush();
	 exit 0;
       }
       if ($msg eq "ERROR PEER NOT RESPONDING") {
	 print "Peer down?\n";
	 $dead=1;
       } elsif ($dead) {
	 Comm::Conn::_keep_alive($fh);
	 print "Peer back to life\n";
	 $dead=0;
       }
       print "Msg: $msg\n";
     }

     sub wrong {
       my ($fh, $msg) = @_;
       print "How, damn!\n";
     }

     $fh=new IO::Socket::UNIX(Peer=>"toto");
     Comm::Conn::add_handle($fh, \&cb);
     $fh2=new IO::Handle;
     Comm::Reactor::add_acceptor($fh2->fdopen(fileno(STDIN),"r"),\&send_msg);

     sub send_msg {
       my ($std)=@_;
       $msg=<STDIN>;
       if (!defined($msg)) {
	 Comm::Reactor::flush();
	 exit;
       }
       chop $msg;
       #	Comm::Conn::send_message_with_ack($fh, $msg,\&wrong) if $msg;
       Comm::Conn::send_message_with_ack($fh, $msg,\&wrong);
       Comm::Reactor::flush(), exit if $msg eq "quit";
     }

     print "Type messages. RETURN on empty line or 'quit' to exit.\n";
     Comm::Reactor::loop();

=head1 Interface

=over 4

=cut

package Comm::Conn;

use strict;
use Comm::Reactor;
use Comm::Tags;
use vars qw(%ack %alive %fh_cb);

=item init ( FILENAME ) 

Initialize the module by reading the option tags in the file FILENAME. If no
filename is given, or if needed options tags have no value, default will be
provided.

=cut

sub init {
  my ($file)=@_;
  if (defined $file) {
    Tags::init($file);
  }
  $Tags::tags{"ack_timeout"}=5 unless exists $Tags::tags{"ack_timeout"};
  $Tags::tags{"ping_try"}=10 unless exists $Tags::tags{"ping_try"};
  $Tags::tags{"ping_timeout"}=5 unless exists $Tags::tags{"ping_timeout"};
}

=item add_handle ( HANDLE, FUNC )

See B<Comm::Reactor>.

=cut

sub add_handle {
  my ($fh, $cb)=@_;
  my $func;
  my $time;
  Comm::Reactor::add_handle($fh, \&_rcv_message);
  $fh_cb{$fh}=$cb;
  _keep_alive($fh);
}

=item remove_handle ( HANDLE )

See B<Comm::Reactor>.

=cut

sub remove_handle {
  my ($fh)=@_;
  delete $fh_cb{$fh};
  Comm::Reactor::remove_event($alive{$fh}->{"time"},
			      $alive{$fh}->{"func"});
  delete $alive{$fh};
  delete $ack{$fh} if exists $ack{$fh};
  Comm::Reactor::remove_handle($fh);
}

=item send_message ( HANDLE, MSG )

Send the given message on the given handle.

=cut

sub send_message {
  my ($fh, $msg)=@_;
  $msg="MSG ".$msg;
  Comm::Reactor::send_message($fh, $msg);
}

=item send_message_with_ack ( HANDLE, MSG, FUNC )

Send the given message on the given handle and ask the peer to acknowledge the
reception of the message. If such a confirmation is not given within 5 (or
ack_timeout) seconds, the given function is called with the handle and the
message as arguments.

=cut

sub send_message_with_ack {
  my ($fh, $msg, $cb)=@_;
  my $msg1="CONN ACK ".$msg;
  Comm::Reactor::send_message($fh, $msg1);
  my $func=$ack{$fh}->{$msg}->{"func"}=
    sub { _not_ack_func($fh, $cb, $msg); };
  my $time=$ack{$fh}->{$msg}->{"time"}=time()+$Tags::tags{"ack_timeout"};
  Comm::Reactor::add_event($time, $func);
}

# Private methods
sub _rcv_message {
  my ($fh, $msg)=@_;
  if (!defined($msg)) {
    &{$fh_cb{$fh}}($fh, undef);
    return;
  }
  if (($msg=~s/^MSG //) or ($msg eq "ERROR")) {
    &{$fh_cb{$fh}}($fh, $msg);
    return;
  }
  if ($msg=~s/^CONN //) {
    if ($msg=~s/^ACK //) {
      my $rep="CONN REP ".$msg;
      Comm::Reactor::send_message($fh, $rep);
      &{$fh_cb{$fh}}($fh, $msg);
      return;
    }
    if ($msg=~s/^REP //) {
      if (exists $ack{$fh}->{$msg}) {
	my $func=$ack{$fh}->{$msg}->{"func"};
	my $time=$ack{$fh}->{$msg}->{"time"};
	Comm::Reactor::remove_event($time, $func);
	delete $ack{$fh}->{$msg};
	return;
      }
    }
    if ($msg=~s/^PING //) {
      Comm::Reactor::send_message($fh,"CONN REP_PING ");
      return;
    }
    if ($msg=~s/^REP_PING //) {
      my $time=$alive{$fh}->{"time"};
      my $func=$alive{$fh}->{"func"};
      Comm::Reactor::remove_event($time,$func);
      _keep_alive($fh);
    }
    # See below ...
  } else {
    # Find something sensible to do here ...
  }
}

sub _alive_func {
  my ($fh) = @_;
  my $time=time()+$Tags::tags{"ping_timeout"};
  my $func=sub { _not_alive_func($fh); };
  $alive{$fh}->{"time"}=$time;
  $alive{$fh}->{"func"}=$func;
  Comm::Reactor::add_event($time, $func);
  Comm::Reactor::send_message($fh,"CONN PING ");
}

sub _not_alive_func {
  my ($fh)=@_;
  &{$fh_cb{$fh}}($fh,"ERROR PEER NOT RESPONDING");
  delete $alive{$fh};
}

=item _keep_alive ( HANDLE ) - utility function

Set the timer to check that the peer at the other side of the handle is still
alive. Only usefull once the peer has been set dead, to resurect it.

=back

=cut

sub _keep_alive {
  my ($fh) = @_;
  my $func=$alive{$fh}->{"func"}=sub { _alive_func($fh);};
  my $time=$alive{$fh}->{"time"}=time()+$Tags::tags{"ping_try"};
  Comm::Reactor::add_event($time,$func);
}

sub _not_ack_func {
  my ($fh, $cb, $msg)=@_;
  &{$cb}($fh,$msg);
  delete $ack{$fh}->{$msg};
}

=head1 Option tags

=over 4

=item ack_timeout

How much seconds before we give up and consider there will be no ack (default
5).

=item ping_try

How much seconds between each ping on a peer (default 10).

=item ping_timeout

How much time before we consider a peer as not respondig (default 5).

=back 4

=head1 BUGS

I hope not.

=head1 AUTHOR

Frederic Dumont <fdm@cs.purdue.edu>

=cut

1;
