view release on metacpan or  search on metacpan

lib/Event/RPC/Client.pm  view on Meta::CPAN

    Event::RPC::Message->set_max_packet_size($value);
}

sub new {
    my $class = shift;
    my %par   = @_;
    my  ($server, $host, $port, $classes, $class_map, $error_cb, $timeout) =
    @par{'server','host','port','classes','class_map','error_cb','timeout'};
    my  ($ssl, $ssl_ca_file, $ssl_opts, $auth_user, $auth_pass, $insecure_msg_fmt_ok) =
    @par{'ssl','ssl_ca_file','ssl_opts','auth_user','auth_pass','insecure_msg_fmt_ok'};

    $server ||= '';
    $host   ||= '';
    $insecure_msg_fmt_ok = 1 unless defined $insecure_msg_fmt_ok;

    if ( $server ne '' and $host eq '' ) {
        warn "Option 'server' is deprecated. Use 'host' instead.";
        $host = $server;
    }

    my $self = bless {
        host                => $server,
        server              => $host,
        port                => $port,
        timeout             => $timeout,
        classes             => $classes,
        class_map           => $class_map,
        ssl                 => $ssl,
        ssl_ca_file         => $ssl_ca_file,
        ssl_opts            => $ssl_opts,
        auth_user           => $auth_user,
        auth_pass           => $auth_pass,
        error_cb            => $error_cb,
        message_format      => $Event::RPC::Client::DEFAULT_MESSAGE_FORMAT,
        insecure_msg_fmt_ok => $insecure_msg_fmt_ok,
        loaded_classes      => {},
        connected           => 0,
    }, $class;

    return $self;
}

sub connect {
    my $self = shift;

    croak "Client is already connected" if $self->get_connected;

    my $ssl     = $self->get_ssl;
    my $server  = $self->get_server;
    my $port    = $self->get_port;
    my $timeout = $self->get_timeout;

    $self->set_message_format($Event::RPC::Client::DEFAULT_MESSAGE_FORMAT);

    #-- Client may try to fallback to Storable
    Event::RPC::Message::Negotiate->set_storable_fallback_ok(1)
        if $self->get_message_format eq 'Event::RPC::Message::Negotiate' and
           $self->get_insecure_msg_fmt_ok;

    if ( $ssl ) {
        eval { require IO::Socket::SSL };
        croak "SSL requested, but IO::Socket::SSL not installed" if $@;
    }

    my $sock;
    if ( $ssl ) {
        my @verify_opts;
        if ( $self->get_ssl_ca_file or $self->get_ssl_ca_path ) {
            push @verify_opts, (
                SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
                SSL_ca_file     => $self->get_ssl_ca_file,
                SSL_ca_path     => $self->get_ssl_ca_path,
            );
        }
        else {
            push @verify_opts, (
                SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(),
            );
        }

        my $ssl_opts = $self->get_ssl_opts;

        $sock = IO::Socket::SSL->new(
            Proto    => 'tcp',
            PeerPort => $port,
            PeerAddr => $server,
            Type     => SOCK_STREAM,
            Timeout  => $timeout,
            @verify_opts,
            ($ssl_opts?%{$ssl_opts}:()),
        )
        or croak "Can't open SSL connection to $server:$port: $IO::Socket::SSL::ERROR";
    }
    elsif ($server eq "unix/") {
        $sock = IO::Socket::UNIX->new(
            Type => IO::Socket::UNIX::SOCK_STREAM(),
            Peer => $port,
        )
        or croak "Can't open Unix Domain connection to $server:$port - $!";
    }
    else {
        $sock = IO::Socket::INET->new(
            Proto    => 'tcp',
            PeerPort => $port,
            PeerAddr => $server,
            Type     => SOCK_STREAM,
            Timeout  => $timeout,
        )
        or croak "Can't open TCP connection to $server:$port - $!";
    }

    $sock->autoflush(1);

    $self->set_sock($sock);

    eval {
        #-- Perform message format negotitation if we are not
        #-- configured to a specific format already.
        $self->negotiate_message_format
            if $self->get_message_format eq 'Event::RPC::Message::Negotiate';

        $self->check_version;
    };

    if ( $@ ) {
        $self->disconnect;
        die $@;
    }

    my $auth_user = $self->get_auth_user;
    my $auth_pass = $self->get_auth_pass;

    if ( $auth_user ) {
        my $rc = $self->send_request(
            {   cmd  => 'auth',
                user => $auth_user,
                pass => $auth_pass,
            }
        );
        if ( not $rc->{ok} ) {
            $self->disconnect;
            croak $rc->{msg};
        }
    }

    if ( not $self->get_classes ) {
        $self->load_all_classes;
    }
    else {
        $self->load_classes;
    }

lib/Event/RPC/Client.pm  view on Meta::CPAN

=item B<class_map>

Optionally you can map the class names from the server to a
different name on the local client using the B<class_map> hash.

This is necessary if you like to use the same classes locally
and remotely. Imported classes from the server are by default
registered under the same name on the client, so this conflicts
with local classes named identically.

On the client you access the remote classes under the name
assigned in the class map. For example with this map

  class_map => { "Event::ExecFlow::Job" => "_srv::Event::ExecFlow::Job" }

you need to write this on the client, if you like to create
an object remotely on the server:

  my $server_job = _srv::Event::ExecFlow::Job->new ( ... );

and this to create an object on the client:

  my $client_job = Event::ExecFlow::Job->new ( ... );

The server knows nothing of the renaming on client side, so you
still write this on the server to create objects there:

  my $job = Event::ExecFlow::Job->new ( ... );

=back

=head2 SSL OPTIONS

If the server accepts only SSL connections you need to enable
ssl here in the client as well. By default the SSL connection
will be established without any peer verification, which makes
Man-in-the-Middle attacks possible. If you want to prevent that,
you need to set either B<ssl_ca_file> or B<ssl_ca_path> option.

=over 4

=item B<ssl>

Set this option to 1 to encrypt the network connection using SSL.

=item B<ssl_ca_file>

Path to the the Certificate Authority's certificate file
(ca.crt), your server key was signed with.

=item B<ssl_ca_path>

Path of a directory containing several trusted certificates with
a proper index. Please refer to the OpenSSL documentation for
details about setting up such a directory.

=item B<ssl_opts>

This optional parameter takes a hash reference of options
passed to IO::Socket::SSL->new(...) to have more control
over the SSL connection. For example you can set the
'SSL_verifycn_name' here if the server certificate common
name doesn't match to the hostname you use to resolve
the server IP or use you have to use a static server IP
address or something like that. 

=back

=head2 AUTHENTICATION OPTIONS

If the server requires user authentication you need to set
the following options:

=over 4

=item B<auth_user>

A valid username.

=item B<auth_pass>

The corresponding password, encrypted using Perl's crypt() function,
using the username as the salt.

Event::RPC has a convenience function for generating such a crypted
password, although it's currently just a wrapper around Perl's
builtin crypt() function, but probably this changes someday, so better
use this method:

  $crypted_pass = Event::RPC->crypt($user, $pass);

=back

If the passed credentials are invalid the Event::RPC::Client->connect()
method throws a correspondent exception.

=head2 MESSAGE FORMAT OPTIONS

Event::RPC supports different CPAN modules for data serialisation,
named "message formats" here:

  SERL -- Sereal::Encoder, Sereal::Decoder
  CBOR -- CBOR::XS
  JSON -- JSON::XS
  STOR -- Storable

Server and client negotiate automatically which format is
best to use. The server sends a list of supported formats
to the client which takes the first one which is available.

For the client there is one option to influence this
format negotiation mechanism:

=over 4

=item B<insecure_msg_fmt_ok>

The Storable module is known to be insecure, so it should
be taken as the last option only. By default the Client
would do so. You can prevent that by setting this option