view release on metacpan or  search on metacpan

lib/AnyEvent/WebSocket/Server.pm  view on Meta::CPAN

package AnyEvent::WebSocket::Server;
use strict;
use warnings;
use Carp;
use AnyEvent::Handle;
use Protocol::WebSocket::Handshake::Server;
use Try::Tiny;
use AnyEvent::WebSocket::Connection;

our $VERSION = "0.10";

sub new {
    my ($class, %args) = @_;
    my $validator = $args{validator};
    if(defined($validator) && ref($validator) ne "CODE") {
        croak "validator parameter must be a code-ref";
    }
    my $handshake = defined($args{handshake}) ? $args{handshake}
        : defined($validator) ? sub { my ($req, $res) = @_; return ($res, $validator->($req)); }
        : sub { $_[1] };
    if(ref($handshake) ne "CODE") {
        croak "handshake parameter must be a code-ref";
    }
    my $self = bless {
        handshake => $handshake,
        map { ($_ => $args{$_}) } qw(ssl_key_file ssl_cert_file max_payload_size),
    }, $class;
    return $self;
}

sub _create_on_error {
    my ($cv) = @_;
    return sub {
        my ($handle, $fatal, $message) = @_;
        if($fatal) {
            $cv->croak("connection error: $message");
        }else {
            warn $message;
        }
    };
}

sub _handle_args_tls {
    my ($self) = @_;
    if(!defined($self->{ssl_key_file}) && !defined($self->{ssl_cert_file})) {
        return ();
    }
    if(!defined($self->{ssl_cert_file})) {
        croak "Only ssl_key_file is specified. You need to specify ssl_cert_file, too.";
    }
    return (
        tls => "accept",
        tls_ctx => {
            cert_file => $self->{ssl_cert_file},
            defined($self->{ssl_key_file}) ? (key_file => $self->{ssl_key_file}) : ()
        }
    );
}

sub _do_handshake {
    my ($self, $cv_connection, $fh, $handshake) = @_;
    my $handshake_code = $self->{handshake};
    my $handle = AnyEvent::Handle->new(
        $self->_handle_args_tls,
        fh => $fh, on_error => _create_on_error($cv_connection)
    );
    my $read_cb = sub {