File Coverage

blib/lib/AnyEvent/Finger/Server.pm

Criterion	Covered	Total	%
statement	93	101	92.0
branch	27	32	84.3
condition	9	10	90.0
subroutine	15	17	88.2
pod	4	4	100.0
total	148	164	90.2

package AnyEvent::Finger::Server;

use strict;
use warnings;
use Carp qw( carp croak );
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket qw( tcp_server );
use AnyEvent::Finger::Transaction;
use AnyEvent::Finger::Request;
use AnyEvent::Finger::Response;

# ABSTRACT: Simple asynchronous finger server
our $VERSION = '0.11'; # VERSION


sub new
{
  my $class = shift;
  my $args     = ref $_[0] eq 'HASH' ? (\%{$_[0]}) : ({@_});
  my $port = $args->{port};
  $port = 79 unless defined $port;
  my $forward_deny = $args->{forward_deny};
  $forward_deny = 0 unless defined $forward_deny;
  my $forward = $args->{forward};
  $forward = 0 unless defined $forward;
  bless {
    hostname     => $args->{hostname},
    port         => $port,
    on_error     => $args->{on_error}     || sub { carp $_[0] },
    on_bind      => $args->{on_bind}      || sub { },
    forward_deny => $forward_deny,
    forward      => $forward,
  }, $class;
}


sub start
{
  my $self     = shift;
  my $callback = shift;
  my $args     = ref $_[0] eq 'HASH' ? (\%{$_[0]}) : ({@_});

  croak "already started" if $self->{guard};

  for(qw( hostname port on_error on_bind forward forward_deny ))
  {
    next if defined $args->{$_};
    $args->{$_} = $self->{$_};
  }


  my $forward = $args->{forward};
  $forward = $self->{forward} unless defined $forward;
  if($forward)
  {
    unless(ref $forward)
    {
      require AnyEvent::Finger::Client;
      $args->{forward} = AnyEvent::Finger::Client->new;
    }
  }

  my $cb = sub {
    my ($fh, $host, $port) = @_;

    my $handle;
    $handle = AnyEvent::Handle->new(
      fh       => $fh,
      on_error => sub {
        my ($hdl, $fatal, $msg) = @_;
        $args->{on_error}->($msg);
        $_[0]->destroy;
      },
      on_eof   => sub {
        $handle->destroy;
      },
    );

    $handle->push_read( line => sub {
      my($handle, $line) = @_;
      $line =~ s/\015?\012//g;

      my $res = sub {
        my $lines = shift;
        $lines = [ $lines ] unless ref $lines eq 'ARRAY';
        foreach my $line (@$lines)
        {
          if(defined $line)
          {
            $handle->push_write($line . "\015\012");
          }
          else
          {
            $handle->destroy;
            return;
          }
        }
      };

      bless $res, 'AnyEvent::Finger::Response';
      my $req = AnyEvent::Finger::Request->new($line);

      my $tx = bless {
        req            => $req,
        res            => $res,
        remote_port    => $port,
        local_port     => $self->{bindport},
        remote_address => $host,
      }, 'AnyEvent::Finger::Transaction';

      if($args->{forward_deny} && $tx->req->forward_request)
      {
        $res->(['finger forwarding service denied', undef]);
        return;
      }

      if($forward && $req->forward_request)
      {
        my $host = pop @{ $req->hostnames };
        my $new_request = join '@', $req->username, @{ $req->hostnames };
        $new_request = '/W ' . $new_request if $req->verbose;
        $forward->finger($new_request, sub {
          my $lines = shift;
          push @$lines, undef;
          $res->($lines);
        }, { hostname => $host });
        return;
      }

      $callback->($tx);
    });
  };

  my $port = $args->{port};
  undef $port if $port == 0;

  $self->{guard} = tcp_server $args->{hostname}, $port, $cb, sub {
    my($fh, $host, $port) = @_;
    $self->{bindport} = $port;
    $args->{on_bind}->($self);
  };

  $self;
}


sub bindport { shift->{bindport} }


sub stop
{
  my($self) = @_;
  delete $self->{guard};
  delete $self->{bindport};
  $self;
}

1;

__END__