view release on metacpan or  search on metacpan

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

    }

    $server->set_active_connection(undef);

    $message->set_data($rc);

    my $watcher = $self->get_server->get_loop->add_io_watcher (
        fh      => $self->get_sock,
        poll    => 'w',
        cb      => sub {
            if ( $message->write ) {
                $self->get_server->get_loop->del_io_watcher($self->get_write_watcher)
                    if $self->get_write_watcher;
                $self->set_write_watcher();
            }
            1;
        },
    );

    $self->set_write_watcher($watcher);

    1;
}

sub client_requests_message_format {
    my $self = shift;
    my ($client_format) = @_;

    foreach my $format ( @{$self->get_server->get_message_formats} ) {
        if ( $client_format eq $format ) {
            $self->set_message_format(
                Event::RPC::Message::Negotiate->known_message_formats
                                              ->{$client_format}
            );

            eval "use ".$self->get_message_format;
            return { ok => 0, msg => "Server rejected format '$client_format': $@" }
                if $@;

            return { ok => 1 };
        }
    }

    return { ok => 0, msg => "Server rejected format '$client_format'" };
}

sub authorize_user {
    my $self = shift;
    my ($request) = @_;

    my $user = $request->{user};
    my $pass = $request->{pass};

    my $auth_module = $self->get_server->get_auth_module;

    return {
        ok  => 1,
        msg => "Not authorization required",
    } unless $auth_module;

    my $ok = $auth_module->check_credentials ($user, $pass);

    if ( $ok ) {
        $self->set_auth_user($user);
        $self->set_is_authenticated(1);
        $self->log("User '$user' successfully authorized");
        return {
            ok  => 1,
            msg => "Credentials Ok",
        };
    }
    else {
        $self->log("Illegal credentials for user '$user'");
        return {
            ok  => 0,
            msg => "Illegal credentials",
        };
    }
}

sub create_new_object {
    my $self = shift;
    my ($request) = @_;

    # Let's create a new object
    my $class_method = $request->{method};
    my $class = $class_method;
    $class =~ s/::[^:]+$//;
    $class_method =~ s/^.*:://;

    # check if access to this class/method is allowed
    if ( not defined $self->get_classes->{$class}->{$class_method} or
         $self->get_classes->{$class}->{$class_method} ne '_constructor' ) {
            $self->log ("Illegal constructor access to $class->$class_method");
            return {
                ok  => 0,
                msg => "Illegal constructor access to $class->$class_method"
            };

    }

    # ok, load class and execute the method
    my $object = eval {
        # load the class if not done yet
        $self->load_class($class) if $self->get_server->get_load_modules;

        # resolve object params
        $self->resolve_object_params ($request->{params});

        $class->$class_method (@{$request->{params}})
    };

    # report error
    if ( $@ ) {
        $self->log ("Error: can't create object ".
                    "($class->$class_method): $@");
        return {
            ok  => 0,
            msg => $@,
        };
    }

    # register object
    $self->get_server->register_object ($object, $class);
    $self->get_client_oids->{"$object"} = 1;

    # log and return
    $self->log (5,
        "Created new object $class->$class_method with oid '$object'",
    );

    return {
        ok  => 1,
        oid => "$object",
    };
}

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

                    if not defined $self->get_objects->{$key};
            $par = $self->get_objects->{$key}->{object};
        }
    }

    1;
}

1;

__END__

=encoding utf8

=head1 NAME

Event::RPC::Connection - Represents a RPC connection

=head1 SYNOPSIS

Note: you never create instances of this class in your own code,
it's only used internally by Event::RPC::Server. But you may request
connection objects using the B<connection_hook> of Event::RPC::Server
and then having some read access on them.

  my $connection = Event::RPC::Server::Connection->new (
      $rpc_server, $client_socket
  );

As well you can get the currently active connection from your
Event::RPC::Server object:

  my $server     = Event::RPC::Server->instance;
  my $connection = $server->get_active_connection;

=head1 DESCRIPTION

Objects of this class represents a connection from an Event::RPC::Client
to an Event::RPC::Server instance. They live inside the server and
the whole Client/Server protocol is implemented here.

=head1 READ ONLY ATTRIBUTES

The following attributes may be read using the corresponding
get_ATTRIBUTE accessors:

=over 4

=item B<cid>

The connection ID of this connection. A number which is unique
for this server instance.

=item B<server>

The Event::RPC::Server instance this connection belongs to.

=item B<is_authenticated>

This boolean value reflects whether the connection is authenticated
resp. whether the client passed correct credentials.

=item B<auth_user>

This is the name of the user who was authenticated successfully for
this connection.

=item B<client_oids>

This is a hash reference of object id's which are in use by the client of
this connection. Keys are the object ids, value is always 1.
You can get the corresponding objects by using the

  $connection->get_client_object($oid)

method.

Don't change anything in this hash, in particular don't delete or add
entries. Event::RPC does all the necessary garbage collection transparently,
no need to mess with that.

=back

=head1 AUTHORS

  Jörn Reder <joern AT zyn.de>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005-2015 by Jörn Reder <joern AT zyn.de>.

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut